Copy multiple sheets to a new workbook while keeping values only and pivot table

Question

I am trying to create a macro that copies the values of multiple worksheets (all but the first one) from an active workbook into a new workbook for which I have put the path in cell F21 of sheet1.

Below is a code that enables me to do so for sheet2. But I can't seem to find how to adapt it so that it does it for sheets 2, 3, 4, 5, 6, 7, 8, and 9.

Another interesting thing to note is that sheet8 contains pivot tables, and it seems to be an issue when copying it to another worksheet.

Do you have any idea how I could do that ? (By the way if you have an idea how to do it, but sheet1 is included in the new file, it is not that much of a problem)

Thanks a lot.

Sub export()

Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet

Dim SavePath As String, i As Integer

Application.ScreenUpdating = False

Set SourceBook = ThisWorkbook

SavePath = Sheets("Sheet1").Range("F21").Text
Set SourceSheet = SourceBook.Sheets("Sheet2")

Set DestBook = Workbooks.Add
Set DestSheet = DestBook.Worksheets.Add

Application.DisplayAlerts = False
For i = DestBook.Worksheets.Count To 2 Step -1
    DestBook.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

SourceSheet.Cells.Copy
With DestSheet.Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
End With

DestSheet.Name = SourceSheet.Name
DestBook.Activate
With ActiveWindow
    .DisplayGridlines = False
    .DisplayWorkbookTabs = False
End With
SourceBook.Activate

Application.DisplayAlerts = False 'Delete if you want overwrite warning
DestBook.SaveAs Filename:=SavePath
Application.DisplayAlerts = True 'Delete if you delete other line

SavePath = DestBook.FullName
DestBook.Close 'Delete if you want to leave copy open
MsgBox ("A copy has been saved to " & SavePath)

End Sub

To copy other worksheets, you to pass either a worksheet object or the worksheet name as an argument to the procedure. — J. Garth, Jun 17 '21 at 01:14
Or loop through the worksheets, e.g. `For each ws in Activeworkbook.Worksheets` — BruceWayne, Jun 17 '21 at 03:57
@BruceWayne, where would you start that loop exactly ? Because it is what I was trying to do, but didn't seem to find the right spot to make the loop start — Janson Martin, Jun 17 '21 at 05:34

score 0 · Answer 1 · answered Jun 18 '21 at 08:54

I strongly encourage you to look into the following topics. I have included a couple of links to get you started.

Passing arguments to procedures (https://www.homeandlearn.org/passing_values_to_a_sub.html)
Parameters and arguments (https://stackoverflow.com/questions/156767/whats-the-difference-between-an-argument-and-a-parameter#:~:text=Generally%20speaking%2C%20the%20terms%20parameter,function%20when%20it%20is%20called.)
Modular Programming (https://en.wikipedia.org/wiki/Modular_programming)

The code below passes arguments and loops through all of the worksheets. This setup allows you to copy any number of (contiguous) sheets by changing the values of the iSheetStart and iSheetEnd arguments in the DoExport procedure. Because the logic has been abstracted and split up into a more modular form, it is generic enough that you can use the same code over and over again without re-writing the code every time. Some of this logic can be split up further into more procedures as well.

You could also abstract the code further by changing all of the situations where you have "Delete if..." comments to procedure parameters. You can also make SavePath, SourceBook, Destbook, etc. parameters.

I also encourage you to look at the Worksheets.Copy method (https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy). This may be faster than what you're currently doing, although all I don't believe there's an option to exclude formatting.

The procedure that you should run is DoExport. All other procedures will be called by it.

Option Explicit
    
    
Sub DoExport()

    Export iStartSheet:=2, iEndSheet:=9
    
End Sub


Sub Export(iStartSheet As Integer, iEndSheet As Integer)

    Dim SourceBook      As Workbook:    Set SourceBook = ThisWorkbook
    Dim SavePath        As String:      SavePath = SourceBook.Sheets("Sheet1").Range("F21").Text
    Dim DestBook        As Workbook:    Set DestBook = Workbooks.Add
    Dim iSheetNum       As Integer
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    For iSheetNum = iStartSheet To iEndSheet
        CopySheet SourceBook, DestBook, iSheetNum
    Next iSheetNum
    
    DestBook.Activate
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayWorkbookTabs = False
    End With
    
    DestBook.SaveAs Filename:=SavePath
    With Application
        .DisplayAlerts = False 'Delete if you want overwrite warning
        .DisplayAlerts = True 'Delete if you delete other line
    End With
    
    DestBook.Close 'Delete if you want to leave copy open
    MsgBox ("A copy has been saved to " & SavePath)

End Sub


Sub CopySheet(SourceBook As Workbook, ByRef DestBook As Workbook, iSheetNum As Integer)

    Dim SourceSheet     As Worksheet
    Dim DestSheet       As Worksheet
    
    With DestBook.Sheets
        Set DestSheet = IIf(.Count < iSheetNum, _
                            .Add(After:=DestBook.Sheets(.Count)), _
                            DestBook.Sheets(iSheetNum))
    End With
    
    Set SourceSheet = SourceBook.Sheets(iSheetNum)
    SourceSheet.Cells.Copy
    With DestSheet
        With .Range("A1")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
        End With
        .Name = SourceSheet.Name
    End With

End Sub

Copy multiple sheets to a new workbook while keeping values only and pivot table

1 Answers1