Repeat macro to copy/paste different ranges to different locations

[akg742]

I (finally) figured out how to paste just the values and formatting of a pivot table to another tab. Unfortunately, I have 2 more PTs which need the same treatment. There has to be a way to repeat the steps with new source and destination cells without repeating the entire current code, right? I haven't been able to find examples of anyone else doing this so I'm hoping someone here can help. Basically, what I want to do is:

• macro selects cell in pivot table in worksheet alpha, cell A3
• code copies PT to worksheet beta, cell A3
• macro selects cell in 2nd pivot table in worksheet alpha, cell A8
• code copies PT to worksheet beta, cell A8
• macro selects cell in pivot table in worksheet gamma, cell A3
• code copies PT to worksheet zeta, cell A3
• end

(the macro automatically pastes the pivot tables in column A and whichever row the original starts so that part isn't an issue)

Thank you!

 

[excel_learnerz]

To achieve this, you can create a reusable subroutine that takes the source and destination worksheets and the cell addresses as arguments. Here's an example:

Sub CopyPastePivotTableValues(srcWs As Worksheet, srcCell As String, destWs As Worksheet, destCell As String)
    srcWs.Range(srcCell).Select
    srcWs.PivotTables(1).TableRange2.Copy
    
    With destWs.Range(destCell)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
    
    Application.CutCopyMode = False
End Sub

Sub Main()
    Application.ScreenUpdating = False
    
    Dim wsAlpha As Worksheet
    Dim wsBeta As Worksheet
    Dim wsGamma As Worksheet
    Dim wsZeta As Worksheet

    Set wsAlpha = ThisWorkbook.Worksheets("alpha")
    Set wsBeta = ThisWorkbook.Worksheets("beta")
    Set wsGamma = ThisWorkbook.Worksheets("gamma")
    Set wsZeta = ThisWorkbook.Worksheets("zeta")

    ' Copy the first pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A3", wsBeta, "A3"

    ' Copy the second pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A8", wsBeta, "A8"

    ' Copy the pivot table from gamma to zeta
    CopyPastePivotTableValues wsGamma, "A3", wsZeta, "A3"

    Application.ScreenUpdating = True
End Sub

In this example, the CopyPastePivotTableValues subroutine is responsible for copying and pasting the pivot table values and formatting from the source cell to the destination cell. The Main subroutine sets up the worksheets and calls CopyPastePivotTableValues with the appropriate arguments for each pivot table.

 

[akg742]

To achieve this, you can create a reusable subroutine that takes the source and destination worksheets and the cell addresses as arguments. Here's an example:

Sub CopyPastePivotTableValues(srcWs As Worksheet, srcCell As String, destWs As Worksheet, destCell As String)
    srcWs.Range(srcCell).Select
    srcWs.PivotTables(1).TableRange2.Copy
   
    With destWs.Range(destCell)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
   
    Application.CutCopyMode = False
End Sub

Sub Main()
    Application.ScreenUpdating = False
   
    Dim wsAlpha As Worksheet
    Dim wsBeta As Worksheet
    Dim wsGamma As Worksheet
    Dim wsZeta As Worksheet

    Set wsAlpha = ThisWorkbook.Worksheets("alpha")
    Set wsBeta = ThisWorkbook.Worksheets("beta")
    Set wsGamma = ThisWorkbook.Worksheets("gamma")
    Set wsZeta = ThisWorkbook.Worksheets("zeta")

    ' Copy the first pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A3", wsBeta, "A3"

    ' Copy the second pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A8", wsBeta, "A8"

    ' Copy the pivot table from gamma to zeta
    CopyPastePivotTableValues wsGamma, "A3", wsZeta, "A3"

    Application.ScreenUpdating = True
End Sub

In this example, the CopyPastePivotTableValues subroutine is responsible for copying and pasting the pivot table values and formatting from the source cell to the destination cell. The Main subroutine sets up the worksheets and calls CopyPastePivotTableValues with the appropriate arguments for each pivot table.

Thank you for the help! I'm getting a Run-time error "1004": Select method of range class failed when I try to run this. When I debug, excel highlights "srcWs.Range(srcCell).Select" in the CopyPaste macro. Your macro to copy the pivot tables is completely different from mine (and much simpler) (I modified the code from here) and I'm not sure enough about it to recognize what's wrong. Or should I be using my code there?

 

[excel_learnerz]

The issue you're encountering might be related to the workbook or sheet not being activated before attempting to select the cell. Let's modify the code to activate the source worksheet before selecting the range. Here's the updated:

Sub CopyPastePivotTableValues(srcWs As Worksheet, srcCell As String, destWs As Worksheet, destCell As String)
    srcWs.Activate
    srcWs.Range(srcCell).Select
    srcWs.PivotTables(1).TableRange2.Copy
    
    destWs.Activate
    With destWs.Range(destCell)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
    
    Application.CutCopyMode = False
End Sub

Sub Main()
    Application.ScreenUpdating = False
    
    Dim wsAlpha As Worksheet
    Dim wsBeta As Worksheet
    Dim wsGamma As Worksheet
    Dim wsZeta As Worksheet

    Set wsAlpha = ThisWorkbook.Worksheets("alpha")
    Set wsBeta = ThisWorkbook.Worksheets("beta")
    Set wsGamma = ThisWorkbook.Worksheets("gamma")
    Set wsZeta = ThisWorkbook.Worksheets("zeta")

    ' Copy the first pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A3", wsBeta, "A3"

    ' Copy the second pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A8", wsBeta, "A8"

    ' Copy the pivot table from gamma to zeta
    CopyPastePivotTableValues wsGamma, "A3", wsZeta, "A3"

    Application.ScreenUpdating = True
End Sub

 

[RoryA]

Why do you want to select a cell at all? It doesn't serve any purpose in your code that I can see.

 

[akg742]

The issue you're encountering might be related to the workbook or sheet not being activated before attempting to select the cell. Let's modify the code to activate the source worksheet before selecting the range. Here's the updated:

Sub CopyPastePivotTableValues(srcWs As Worksheet, srcCell As String, destWs As Worksheet, destCell As String)
    srcWs.Activate
    srcWs.Range(srcCell).Select
    srcWs.PivotTables(1).TableRange2.Copy
   
    destWs.Activate
    With destWs.Range(destCell)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
   
    Application.CutCopyMode = False
End Sub

Sub Main()
    Application.ScreenUpdating = False
   
    Dim wsAlpha As Worksheet
    Dim wsBeta As Worksheet
    Dim wsGamma As Worksheet
    Dim wsZeta As Worksheet

    Set wsAlpha = ThisWorkbook.Worksheets("alpha")
    Set wsBeta = ThisWorkbook.Worksheets("beta")
    Set wsGamma = ThisWorkbook.Worksheets("gamma")
    Set wsZeta = ThisWorkbook.Worksheets("zeta")

    ' Copy the first pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A3", wsBeta, "A3"

    ' Copy the second pivot table from alpha to beta
    CopyPastePivotTableValues wsAlpha, "A8", wsBeta, "A8"

    ' Copy the pivot table from gamma to zeta
    CopyPastePivotTableValues wsGamma, "A3", wsZeta, "A3"

    Application.ScreenUpdating = True
End Sub

Thank you! This worked for everything except the second pivot table in Alpha. Instead, the code copies the first PT twice, once in Beta A3 (where I want it) and again in Beta A8 (which should be a completely different table).

 

[akg742]

Thank you! This worked for everything except the second pivot table in Alpha. Instead, the code copies the first PT twice, once in Beta A3 (where I want it) and again in Beta A8 (which should be a completely different table).

I ended up moving the second Alpha pivot table onto its own tab. It copies just fine from there to where I want it and I delete the pivot table sheets in a later step anyway. So it all works, just in a mysterious way.

 

[RoryA]

The code is written to only copy the first pivot table on the specified sheet.