VBA to copy multiple sheets from one wb into new wb's (one wb for each sheet)

user_9534456 0
Viewed 70

Got a wb with 15 sheets, and I need to copy content of selected sheets into new workbooks (one wb for each sheet). VBA below works, but I've got one part I can't figure out. Each sheet I'm copying from holds one pivot table, and I don't want pivot-functions to be copied - only the data. Less file size. By manual, I could skip the top part of the pivot table and copy "A4:BF & lr". When pasted, pivot-functions is gone. But I can't figure out how to add the usual:

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

... into my vba (it won't run). I guess the easiest would be if there is a function that will allow me to copy entire sheet without the pivot-functions, but I don't know how to pull that one off either... Any ideas?

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
copy-paste vba excel
1 Answers

By using BigBen 's idea, and som other changes, this code is now doing what I want it to do. Thanks a lot for helping out!

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
user_95344560
Related