vba - Excel VBA : Copying multiple sheets into new workbook

Question

当我运行此子程序时，出现“需要对象”的错误消息。我有一个用于复制每个特定工作表的版本，该版本工作正常，但此子适用于 WB 中的所有工作表，即复制每个工作表的 WholePrintArea 并将其粘贴到新 WB 中的新工作表中。谢谢...

Sub NewWBandPasteSpecialALLSheets()

  MyBook = ActiveWorkbook.Name ' Get name of this book
  Workbooks.Add ' Open a new workbook
  NewBook = ActiveWorkbook.Name ' Save name of new book

  Workbooks(MyBook).Activate ' Back to original book

  Dim SH As Worksheet

    For Each SH In MyBook.Worksheets

    SH.Range("WholePrintArea").Copy

    Workbooks(NewBook).Activate

        With SH.Range("A1")
            .PasteSpecial (xlPasteColumnWidths)
            .PasteSpecial (xlFormats)
            .PasteSpecial (xlValues)

        End With

    Next

End Sub

Answer 1

尝试执行类似的操作(问题是您尝试使用 MyBook.Worksheets，但 MyBook 不是 Workbook 对象，但是 string，包含工作簿名称。我添加了新变量 Set WB = ActiveWorkbook，因此您可以使用 WB.Worksheets 代替 MyBook.Worksheets):

Sub NewWBandPasteSpecialALLSheets()
   MyBook = ActiveWorkbook.Name ' Get name of this book
   Workbooks.Add ' Open a new workbook
   NewBook = ActiveWorkbook.Name ' Save name of new book

   Workbooks(MyBook).Activate ' Back to original book

   Set WB = ActiveWorkbook

   Dim SH As Worksheet

   For Each SH In WB.Worksheets

       SH.Range("WholePrintArea").Copy

       Workbooks(NewBook).Activate

       With SH.Range("A1")
        .PasteSpecial (xlPasteColumnWidths)
        .PasteSpecial (xlFormats)
        .PasteSpecial (xlValues)

       End With

     Next

End Sub

但是您的代码没有执行您想要的操作:它没有将某些内容复制到新的WB。因此，下面的代码可以为您做到这一点:

Sub NewWBandPasteSpecialALLSheets()
   Dim wb As Workbook
   Dim wbNew As Workbook
   Dim sh As Worksheet
   Dim shNew As Worksheet

   Set wb = ThisWorkbook
   Workbooks.Add ' Open a new workbook
   Set wbNew = ActiveWorkbook

   On Error Resume Next

   For Each sh In wb.Worksheets
      sh.Range("WholePrintArea").Copy

      'add new sheet into new workbook with the same name
      With wbNew.Worksheets

          Set shNew = Nothing
          Set shNew = .Item(sh.Name)

          If shNew Is Nothing Then
              .Add After:=.Item(.Count)
              .Item(.Count).Name = sh.Name
              Set shNew = .Item(.Count)
          End If
      End With

      With shNew.Range("A1")
          .PasteSpecial (xlPasteColumnWidths)
          .PasteSpecial (xlFormats)
          .PasteSpecial (xlValues)
      End With
   Next
End Sub