VBA для копирования нескольких листов из одного wb в новые wb (по одному wb для каждого листа)

Question

Получил wb с 15 листами, и мне нужно скопировать содержимое выбранных листов в новые рабочие книги (по одному wb на каждый лист). VBA ниже работает, но у меня есть одна часть, которую я не могу понять. Каждый лист, с которого я копирую, содержит одну сводную таблицу, и я не хочу копировать сводные функции - только данные. Меньший размер файла. В ручном режиме я мог пропустить верхнюю часть сводной таблицы и скопировать «A4: BF & lr». При вставке pivot-функции больше нет. Но я не могу понять, как добавить обычное:

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

... в мой VBA (он не будет работать). Я полагаю, что проще всего было бы, если бы была функция, которая позволяла бы мне копировать весь лист без pivot-функций, но я тоже не знаю, как это сделать ... Любые идеи?

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