Question

这是我第一次在这里发帖，所以如果我的问题不清楚我会道歉。我有一个vba应用程序，它目前在我的工作簿中包含所有可见的工作表，并为每个工作簿创建新的工作簿。我需要更改此设置，以便我可以将多个工作表添加到同一工作簿中。

ActiveWorkbook.Sheets(1).Visible = False
ActiveWorkbook.Sheets(2).Visible = False

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
FolderName = Sourcewb.path & "\Tracker Workbooks"

'Copy every visible sheet to a new workbook
For Each sh In Sourcewb.Worksheets

    'If the sheet is visible then copy it to a new workbook
    If sh.Visible = -1 Then
        sh.Copy

        'Set Destwb to the new workbook
        Set Destwb = ActiveWorkbook

        'Determine the Excel version and file extension/format
        With Destwb
            If Sourcewb.Name = .Name Then
                MsgBox "Your answer is NO in the security dialog"
                GoTo GoToNextSheet
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End With

        Application.DisplayAlerts = False

        'Save the new workbook and close it
        With Destwb
            .SaveAs FolderName & "\" & Destwb.Sheets(1).Name & FileExtStr,    FileFormat:=FileFormatNum
            .Close False
        End With
        Application.DisplayAlerts = True
    End If
GoToNextSheet:
Next sh

MsgBox "You can find the files in " & FolderName

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

ActiveWorkbook.Sheets(1).Visible = True
ActiveWorkbook.Sheets(2).Visible = True
End Sub

一些给定的代码是复制/粘贴的，但自去年夏天以来我还没有参与这个项目，所以我对自己写的部分感到朦胧。

无论如何，我可以买一张纸＆＃34; 12345＆＃34;我将制作一个新的工作簿并将工作表复制到该工作簿，然后命名工作簿＆＃34; 12345＆＃34;。如果我有床单＆＃34; 54321-1＆＃34;和＆＃34; 54321-2＆＃34;，我需要将它们都复制到名为＆＃34; 54321＆＃34;的同一个工作簿中。有两张名为＆＃34; 54321-1＆＃34;和＆＃34; 54321-2＆＃34;。目前，它将制作2个单独的工作簿：＆＃34; 54321-1＆＃34;和＆＃34; 54321-2＆＃34;。对不起，如果这是一个明显的答案。

谢天谢地，

麦

Answer 1

在Copy method中，您可以指定要复制工作表的位置，否则它将被放置在新工作簿中，这是当前代码中的情况。只需将代码更改为：sh.copy after:=destwb.sheets(1)（注意：只有在您已经设置了destwb之后才能工作，所以请立即复制第一张表。）

根据工作表VBA的名称将多个工作表添加到新工作簿

1 个答案: