Цикл Excel VBA по рабочим листам и копирование и вставка в другой рабочий лист

Question

Я новичок в VBA и пытаюсь написать код для копирования данных с одного рабочего листа на другой. Я проверил различные сайты и попытался написать код, но пока не получаю ошибку. Настройка выглядит следующим образом:

У меня есть различные рабочие листы, большинство из которых являются рабочими листами, основанными на разных командах (я буду называть их рабочими листами), один лист - это данные, которые я импортирую из внешнего банка данных (я буду назовите его Import-Worksheet).

Код должен * l oop проходить через все рабочие листы команды и на основе названия команды, которое всегда находится в ячейке «A2», должно найти все истории, которые принадлежать команде в «Import-Worksheet» (сравнивать ее с «столбцом имени команды») и ТОЛЬКО скопировать «ID», расположенный в «столбце идентификатора», и вставить его во второй ряд «столбца идентификатора» объекта ListObject 1 соответствующего «Рабочего листа команды». Затем он должен найти следующий идентификатор этой команды в «Import-Worksheet» и скопировать его в следующую строку ListObject 1 (все листы имеют несколько списочных объектов с различной длиной и начальными точками). После того, как он прошел все строки, он должен перейти к следующему «Рабочему листу команды».

Я не уверен, должен ли я запускать 1) «для-l oop» + »для -l oop «2)« для цикла »+« расширенный фильтр »или 3)« для цикла »+« для-l oop в сочетании с индексом / соответствием »?

Я использовал if B4 = Epic Id Link поскольку я не хочу применять это ко всем рабочим листам

Пример 1:

Sub AddContent()
Dim sht As Worksheet
Dim i As Variant
Dim x As Long
Dim y As Worksheet
Dim rw As Range

Application.ScreenUpdating = False
For Each sht In ThisWorkbook.Worksheets  
    sht.Activate         
    i = sht.Range("A2")
    Set y = ActiveSheet
    If sht.Range("B4").Value = "EPIC ID Link" Then

        Sheets("Jira Import").Select
        ' Find the last row of data
        FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
        ' Loop through each row
        For x = 5 To FinalRow
            ' Decide if to copy based on column D
            ThisValue = Cells(x, 19).Value
            If ThisValue = i Then
                Cells(x, 4).Copy
                y.ListObjects(1).ListColumns("US ID").Select
                NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                Cells(NextRow, 1).Select
                ActiveSheet.Paste
                Sheets("Jira Import").Select
            End If
        Next x

    End If

Next sht
Application.ScreenUpdating = True

End Sub

Пример 2:

Sub AddContent()

Dim sht As Worksheet
Dim i As Variant
Dim rgData As Range, rgCriteria As Range, rgOutput As Range

Application.ScreenUpdating = False

For Each sht In ThisWorkbook.Worksheets

    sht.Activate

    Set i = ActiveSheet.Range("A2")
    If sht.Range("B4").Value = "EPIC ID Link" Then

        Set rgData = ThisWorkbook.Worksheets("Jira Import").Range("S5").CurrentRegion
        Set rgCriteria = i
        Set rgOutput = ActiveSheet.ListObjects(1).ListColumns("US ID").DataBodyRange
        rgData.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rgOutput, Unique:=True

    End If

Next sht

Application.ScreenUpdating = True

End Sub

Решение этой проблемы спасло бы меня ручной работы!