CODEWITHSUNDEEP
excelvba
Emilyan
Emilyan

Reputation: 1

VBA Code to Loop Copy/Paste Data for multiple sheets with Unique Table/Sheet Names

I am fairly new with Excel VBA and am am looking to write a loop that would perform the below function for 11 different sheets/tables.

I made 22 string variables -

Also, the variables "DestWbk" and "ScrWbk" are variables already defined in my code.

Basically I am going through each sheet, deleting the existing table data in the destination workbook, then pasting the new table data from the source workbook.

With DestWbk.Sheets(Q1s).ListObjects(Q1)
    If .ListRows.Count > 0 Then
        .DataBodyRange.Delete
    End If
End With
SrcWbk.Sheets(Q1).Range(Q1).Copy DestWbk.Sheets(Q1s).Range(Q1)

I am aware I could create an array with the table name variables (Q1-Q11) to loop through. Same thing for the sheet name variables (Q1s-Q11s). I am just not sure how to loop through both of these variables simultaneously!

Thank you for your technical expertise on this!

Upvotes: 0

Views: 557

Answers (1)

CDP1802
CDP1802

Reputation: 16382

If the destination sheets are named the same as the source sheets but with 's' added then you don't need to configure any string variables. If they are not then use a dictionary object as a translation table.

update - added error handling

Option Explicit
Sub copytables()

    Dim SrcWbk As Workbook, DestWbk As Workbook
    Dim SrcWs As Worksheet, DestWs As Worksheet
    Dim SrcTbl As ListObject, DestTbl As ListObject
    
    Set SrcWbk = ThisWorkbook
    Set DestWbk = Workbooks.Open("dest.xlsm")
    
    ' source to destination sheet lookup table
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.Add "Class_1_High_A", "Class 1 High Priority (A)" ' Q1, Q1s
    dict.Add "Class_2_High_A", "Class 2 High Priority (A)" ' Q2, Q2s
    dict.Add "Class_3_High_A", "Class 3 High Priority (A)" ' Q3, Q3s
    ' and so on as many as required
    
    Application.ScreenUpdating = False
    For Each SrcWs In SrcWbk.Sheets
        For Each SrcTbl In SrcWs.ListObjects
            If dict.exists(SrcWs.Name) Then
                Set DestTbl = Nothing
                On Error Resume Next
                Set DestTbl = DestWbk.Sheets(dict(SrcWs.Name)).ListObjects(SrcTbl.Name)
                On Error GoTo 0
                If DestTbl Is Nothing Then
                     MsgBox "No destination sheet " & dict(SrcWs.Name) & _
                     " for source sheet " & SrcWs.Name
                Else
                    With DestTbl
                        If .ListRows.Count > 0 Then
                            .DataBodyRange.Delete
                        End If
                        .ListRows.Add
                        SrcTbl.DataBodyRange.Copy .DataBodyRange.Cells(1, 1)
                    End With
                End If
            Else
                MsgBox "No destination sheet configured for " & SrcWs.Name
            End If
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox DestWbk.Name & " Updated"

End Sub

Upvotes: 0

Related Questions