Объединение таблиц из разных листов в Excel

Question

У меня есть 5 различных объявлений Sub, которые в значительной степени делают одно и то же. Единственная часть, которая отличается, - это варианты рабочего листа (каждый Sub использует 2 специфика c worksheets).

Я пытаюсь объединить 5 различных Subs в один кусок.

Приведенный ниже код является примером одного из моих Subs (обратите внимание, что приведенный ниже код изменяется только для всех Subs)

Только код, который изменяется в приведенной ниже группе 1. Sub.

Set ws = wb.Worksheets("A")
Set addWS = wb.Worksheets("A add")

Код для одного из Subs

   ' -- Combines table1 and table2 -- '
    Sub group1()
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim addWS As Worksheet
        Dim counter As Long
        Dim counterAdd As Long 'counter for additional trades

        Set wb = Workbooks("MASTER.xlsm")
        Set ws = wb.Worksheets("A")
        Set addWS = wb.Worksheets("A add")

        ws.Activate 'activate sheet

        ' Checks to see if there is only 1 row or is empty
        If IsEmpty(ws.Range("A11").Value) = True Then
            Exit Sub
        End If

        If IsEmpty(ws.Range("A12").Value) = True And IsEmpty(ws.Range("A11").Value) = False Then
            counter = 1
        Else
            counter = ws.Range("A11", Range("A11").End(xlDown)).Rows.count
        End If


        addWS.Activate 'activate additional sheet

        ' Checks to see if there is only 1 row or is empty
        If IsEmpty(addWS.Range("A11").Value) = True Then
            Exit Sub
        End If

        If IsEmpty(addWS.Range("A12").Value) = True And IsEmpty(addWS.Range("A11").Value) = False Then
            counterAdd = 1
        Else
            counterAdd = addWS.Range("A11", Range("A11").End(xlDown)).Rows.count
        End If


        ' Copy / paste additional trades
        addWS.Range("A11:AB" & counterAdd + 10).Copy

        ws.Activate
        ws.Range("A" & counter + 11).PasteSpecial xlPasteAll
    End Sub

В приведенном ниже коде я попытался превратить это в один Sub с двумя циклами For, однако застрять во втором л oop. Есть ли способ, которым я мог бы oop через две вещи одновременно?

   ' -- Combines table1 and table2 -- '
    Sub group()
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim wsAdd As Worksheet
        Dim counter As Long
        Dim counterAdd As Long 'counter for additional trades
        Dim WSArray As Variant
        Dim WSArrayAdd As Variant

        Set wb = Workbooks("MASTER.xlsm")

        WSArray = Array("A", "B", "C", "D", "E")
        WSArrayAdd = Array("A add", "B add", "C add", "D add", "E add")

        'Loop through WSArray sheets
        For Each currentWS In WSArray
            Set ws = wb.Worksheets(currentWS)
            ws.Activate

            ' Checks to see if there is only 1 row or is empty
            If IsEmpty(ws.Range("A11").Value) = True Then
                ' do nothing
            End If

            If IsEmpty(ws.Range("A12").Value) = True And IsEmpty(ws.Range("A11").Value) = False Then
                counter = 1
            Else
                counter = ws.Range("A11", Range("A11").End(xlDown)).Rows.count
            End If

            For Each currentAddWS In WSArrayAdd
                Set wsAdd = wb.Worksheets(currentAddWS)
                wsAdd.Activate 'activate additional sheet

                ' Checks to see if there is only 1 row or is empty
                If IsEmpty(wsAdd.Range("A11").Value) = True Then
                    ' do nothing
                End If

                If IsEmpty(wsAdd.Range("A12").Value) = True And IsEmpty(wsAdd.Range("A11").Value) = False Then
                    counterAdd = 1
                Else
                    counterAdd = wsAdd.Range("A11", Range("A11").End(xlDown)).Rows.count
                End If


                ' Copy / paste additional trades
                wsAdd.Range("A11:AB" & counterAdd + 10).Copy

                ws.Activate
                ws.Range("A" & counter + 11).PasteSpecial xlPasteAll
            Next currentAddWS
        Next currentWS

    End Sub

Answer 1

Я смог решить это в приведенном ниже коде. Этот код просматривает серию из 10 листов (каждый лист имеет соответствующий лист) и объединяет таблицы в один основной лист.

' -- Combines additional trades table with main table -- '
Sub groupTables()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsAdd As Worksheet
    Dim counter As Long
    Dim counterAdd As Long 'counter for additional trades
    Dim WSArray As Variant
    Dim WSArrayAdd As Variant
    Dim i As Long

    Set wb = Workbooks("MASTER.xlsm")

    WSArray = Array("1", "2", "3", "4", "5")

    'Loop through WSArray sheets
    For Each currentWS In WSArray
        Set ws = wb.Worksheets(currentWS)
        Set wsAdd = wb.Worksheets(WSArray(i) & " add")

        ws.Activate

        ' COUNTS ROWS IN TRADE SHEET
        ' Checks to see if there is only 1 row or is empty
        If IsEmpty(ws.Range("A11").Value) = True Then
            counter = 0  'no trades
        ElseIf IsEmpty(ws.Range("A12").Value) = True And IsEmpty(ws.Range("A11").Value) = False Then
            counter = 1
        Else
            counter = ws.Range("A11", Range("A11").End(xlDown)).Rows.count
        End If

        wsAdd.Activate

        ' COUNTS ROWS IN ADDITIONAL TRADE SHEET
        ' Checks to see if there is only 1 row or is empty
        If IsEmpty(wsAdd.Range("A11").Value) = True Then
            counterAdd = 0  'no trades
        ElseIf IsEmpty(wsAdd.Range("A12").Value) = True And IsEmpty(wsAdd.Range("A11").Value) = False Then
            counterAdd = 1
        Else
            counterAdd = wsAdd.Range("A11", Range("A11").End(xlDown)).Rows.count
        End If

        'Copy Additional trades
        If counterAdd > 0 Then
            wsAdd.Range("A11:AB" & counterAdd + 10).Copy    'Copy additional trades table
            ws.Activate
            ws.Range("A" & counter + 11).PasteSpecial xlPasteAll ' Paste additional trades to main table
        End If

        i = i + 1   'iterate

    Next currentWS

End Sub