VBA копирует диапазон на основе значений с двух отдельных листов

Question

Я не знаю, что делаю не так. Код будет запущен, но он не копирует данные, как ожидалось, все значения, похоже, перезаписываются в строку 1 на целевом листе (tsht) вместо копирования данных на целевой лист. Цель здесь - взять данные и повторить их для каждого округа, указанного на вкладке идентификатора группы (захваченной SubCell.Value). Если коды плана и даты срока совпадают, макрос должен скопировать каждую соответствующую строку из dsht для указанного количества округов на gsht в tsht. Может ли кто-нибудь увидеть мою ошибку или почему этот код хранит данные в верхней строке tsht? способ заставить этот код работать на них. Извините, я не смог скопировать это так же чисто, как мой 1-й блок.

Решение:

Sub GroupID_Breakout()

    Dim dsht As Worksheet 'data sheet target
    Dim gsht As Worksheet
    Dim tsht As Worksheet
    Dim dlrow As Long
    Dim glrow As Long
    Dim tlrow As Long
    Dim SubCell As Range
    Dim rngCell As Range
    Dim Result() As String
    Dim countycount As Long

    Set dsht = ThisWorkbook.Worksheets("Data_No Formulas")
    Set gsht = ThisWorkbook.Worksheets("GroupID")

    'kill clunky processes
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual

    'delete compare tab if it exists
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("Data_Final").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'On Error GoTo Errhandler

    Sheets.Add(After:=Sheets("Data_No Formulas")).Name = "Data_Final" 'create new tab

    Set tsht = ThisWorkbook.Worksheets("Data_Final")

'pull header from dsht to tsht
    With dsht.Range("A2:CN2")
    tsht.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With

    glrow = gsht.Cells(Rows.Count, 1).End(xlUp).Row
    dlrow = dsht.Cells(Rows.Count, 1).End(xlUp).Row

    For Each SubCell In gsht.Range("I2:I" & glrow)
    countycount = SubCell.Value
    Result() = Split(SubCell.Offset(0, -2).Value, ",") 'separates a list of counties by comma to reference as "Result(0)"
        For Each rngCell In dsht.Range("A3:A" & dlrow)
        a = 0
        i = 1
            For i = 1 To countycount
                If SubCell.Offset(0, -4).Value = rngCell.Value And SubCell.Offset(0, -8).Value = rngCell.Offset(0, 5).Value Then 'match dates and plan codes

                    'move row where match is found between dsht and gsht variables
                    With dsht.Range(rngCell, rngCell.Offset(0, 91))
                        tlrow = tsht.Cells(Rows.Count, 1).End(xlUp).Row
                        tsht.Range("A" & (tlrow + 1)).Resize(.Rows.Count, .Columns.Count).Value = .Value
                    End With
                    'place county names captured by split above with each iteration
                    tsht.Range("L" & (tlrow + 1)).Value = Result(a)
                End If
                a = a + 1
            Next i
        Next rngCell
    Next SubCell

    'bring back clunky processes
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox ("Macro Complete!")

    Exit Sub

    Errhandler:

    'bring back clunky processes
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic


    Select Case Err.Number
        'different error handling here
        Case Else
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Summary"
    End Select

    End Sub

Answer 1

tsht.Range("A" & tlrow).Resize(.Rows.Count, .Columns.Count).Value =

должно быть

tsht.Range("A" & (tlrow+1)).Resize(.Rows.Count, .Columns.Count).Value =