VBA将多张纸从一个wb复制到新的wb（每张纸一个wb）

Question

有一个wb，有15张纸，我需要将所选纸的内容复制到新的工作簿中（每张纸一个wb）。下面的VBA可以工作，但是我有一部分我不知道。我要复制的每一张纸都拥有一个数据透视表，我不希望复制数据透视功能-仅复制数据。较小的文件大小。通过手动操作，我可以跳过数据透视表的顶部并复制“ A4：BF＆lr”。粘贴后，枢轴功能消失了。但我不知道如何添加通常的内容：

lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A4:BF" & lr).Copy

...进入我的vba（它将无法运行）。我想最容易的是如果有一个功能可以让我在没有数据透视功能的情况下复制整张纸，但是我也不知道该如何将它拉出来……有什么想法吗？

Sub Test_KIT()

Dim ws As Worksheet

Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets

    If Left(ws.Name, 4) = "s2g1" Or Left(ws.Name, 4) = "s2g2" Then
    ws.Copy

    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\ABC1_999_" & ws.Name & ".xlsx"
    ActiveWorkbook.Close SaveChanges:=False

      End If

    Next ws

End Sub

Answer 1

通过使用BigBen的想法，并进行了其他更改，此代码现在正在执行我想要的操作。非常感谢您的帮助！

Sub Test_KIT4()

Dim ws As Worksheet
Dim NewBook As Workbook

Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets

        Set NewBook = Workbooks.Add
        If ws.Name <> "DATA_ske_ferdigFU" Then

        lr = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A4:BF" & lr).Copy
        NewBook.ActiveSheet.Paste

        NewBook.SaveAs ThisWorkbook.Path & "\ABC1_999_" & ws.Name & ".xlsx"
        NewBook.Close SaveChanges:=False

    End If

  Next ws

NewBook.Close SaveChanges:=False

End Sub