如何将除工作表1之外的每个工作表另存为单独的工作簿?

时间:2019-09-04 15:10:55

标签: excel vba

我有一个包含5张纸的excel工作簿,但我只想将第二张纸保存到第五张纸,但是我不想保存第一张纸。我想将其从保存中排除。我该怎么做?

我尝试了一些代码,但是遇到了困难。

Sub SaveShtsAsBook()

    Dim xcsvFile As String
    Dim datestring As String
    Dim Count As Integer


    datestring = DateValue(Now) & Time
    datestring = Replace(datestring, "/", "_")
    datestring = Replace(datestring, ":", "_")
    datestring = Replace(datestring, " ", "_")

'    Application.WindowState = xlMinimized
'    Application.Visible = False

    Application.EnableEvents = True
   ' Application.Calculation = xlCalculationManual
  '  Application.Wait (Now + TimeValue("0:00:10"))

    For Count = 1 To 3000
    DoEvents
    Next Count


    'For Each Sheet In Worksheets
    For Each Sheet In ThisWorkbook.Worksheets ' Safer way to qualify the worksheets with the workbook where this code lies

       Select Case Sheet.Name
        Case "Sheet1"
        ' do nothing

        Case Else
           xcsvFile = "E:\" & xWs.Name & "_" & datestring & ".csv"
       ' xcsvFile = "E:\" & "\" & xWs.Name & ".csv" 'compare mine to yours to see issues

        xWs.Copy

        Dim newSheet As Workbook 'setting copied sheet to workbook variable for easier coding
        Set newSheet = ActiveSheet.Parent 'parent of worksheet is workbook

        newSheet.SaveAs Filename:=xcsvFile, FileFormat:=xlCSV, CreateBackup:=False
        newSheet.Close False
       End Select
    Next
End Sub

1 个答案:

答案 0 :(得分:3)

问题是您所引用的xWs变量在您的代码中不存在。如果您使用Sheet进行了更改,则它可以像我在Excel上测试的那样完美运行:

Sub SaveShtsAsBook()
    Dim xcsvFile As String
    Dim datestring As String
    Dim Count As Integer

    datestring = DateValue(Now) & Time
    datestring = Replace(datestring, "/", "_")
    datestring = Replace(datestring, ":", "_")
    datestring = Replace(datestring, " ", "_")

'    Application.WindowState = xlMinimized
'    Application.Visible = False

    Application.EnableEvents = True
   ' Application.Calculation = xlCalculationManual
  '  Application.Wait (Now + TimeValue("0:00:10"))

    For Count = 1 To 3000
        DoEvents
    Next Count


    'For Each Sheet In Worksheets
    For Each Sheet In ThisWorkbook.Worksheets ' Safer way to qualify the worksheets with the workbook where this code lies

        Select Case Sheet.Name
            Case "Sheet1"
            ' do nothing

            Case Else
            xcsvFile = "E:\" & Sheet.Name & "_" & datestring & ".csv"
            ' xcsvFile = "E:\" & "\" & xWs.Name & ".csv" 'compare mine to yours to see issues

            Sheet.Copy

            Dim newSheet As Workbook 'setting copied sheet to workbook variable for easier coding
            Set newSheet = ActiveSheet.Parent 'parent of worksheet is workbook

            newSheet.SaveAs Filename:=xcsvFile, FileFormat:=xlCSV, CreateBackup:=False
            newSheet.Close False
        End Select
    Next
End Sub

希望这会有所帮助。