listrows.add (alwaysinsert: true) перезаписывает последнюю строку, а не добавляет строку

Question

У меня есть ежемесячная рабочая тетрадь с данными за несколько недель. Я пытаюсь написать макрос, который будет go просматривать данные за каждую неделю и искать 3 уникальные переменные в каждой строке. Если он найдет эти переменные, я хочу, чтобы он добавил их в таблицу в конце. Я использую listrows.add (alwaysinsert: = true), чтобы добавить новую строку в таблицу. Однако, когда я наблюдаю за запуском макроса, он продолжает вставлять данные поверх данных в последней строке, а не добавлять новую строку. Как мне заставить его добавить строку и перестать перезаписывать данные, которые там есть?

Dim wbact As Workbook
Dim wswk As Worksheet, wsttl As Worksheet, wssu As Worksheet
Dim tblttl As ListObject
Dim tblttlrw As ListRow
Dim ttlrw As Range

Set wbact = ThisWorkbook
Set wsttl = ThisWorkbook.Sheets("Totals")
Set wssu = ThisWorkbook.Sheets("Set Up")
Set tblttl = wsttl.ListObjects("Totals")
Set tblttlrw = tblttl.ListRows.Add(, AlwaysInsert:=True)

Dim i As Long, ytdd As Long, j As Long, lngttl As Long, ytda As Long, ytdu As Long, wk As Long, n As Long, o As Long, k As Long, l As Long
Dim strcon As String, strlstn As String, strfstn As String, att As String, strwk As String


wk = 1
n = 0

Do Until n = 6
    strwk = "Week " & wk
    Set wswk = ThisWorkbook.Sheets(strwk)


    For i = 6 To wswk.Range("b" & Rows.Count).End(xlUp).Row
        If IsEmpty(wswk.Cells(i, 5)) = False And IsEmpty(wswk.Cells(i, 2)) = False And IsEmpty(wswk.Cells(i, 3)) = False Then
            strcon = wswk.Cells(i, 5).Value
            strlstn = wswk.Cells(i, 2).Value
            strfstn = wswk.Cells(i, 3).Value
            With tblttlrw
                .Range(1) = strlstn
                .Range(2) = strfstn
                .Range(3) = wswk.Cells(i, 4).Value
                .Range(4) = wssu.Cells(2, 2).Value
                .Range(5) = wssu.Cells(2, 3).Value
                .Range(6) = strcon
                .Range(7) = wswk.Cells(i, 6)
                .Range(8) = wswk.Cells(i, 7)
                .Range(9) = wswk.Cells(i, 17)
                .Range(10) = wswk.Cells(i, 19)
                .Range(11) = wswk.Cells(i, 20)
            End With
        End If
        Next i

    n = n + 1
    wk = wk + 1

Loop
End Sub

Answer 1

Попробуйте так:

Dim wbact As Workbook
Dim wswk As Worksheet, wsttl As Worksheet, wssu As Worksheet
Dim tblttl As ListObject
Dim tblttlrw As ListRow
Dim ttlrw As Range

Set wbact = ThisWorkbook
Set wsttl = ThisWorkbook.Sheets("Totals")
Set wssu = ThisWorkbook.Sheets("Set Up")
Set tblttl = wsttl.ListObjects("Totals")
Set tblttlrw = tblttl.ListRows.Add

Dim i As Long, ytdd As Long, j As Long, lngttl As Long, ytda As Long, ytdu As Long, wk As Long, n As Long, o As Long, k As Long, l As Long
Dim strcon As String, strlstn As String, strfstn As String, att As String, strwk As String


wk = 1
n = 0

Do Until n = 6
    strwk = "Week " & wk
    Set wswk = ThisWorkbook.Sheets(strwk)


    For i = 6 To wswk.Range("b" & Rows.Count).End(xlUp).Row
        If IsEmpty(wswk.Cells(i, 5)) = False And IsEmpty(wswk.Cells(i, 2)) = False And IsEmpty(wswk.Cells(i, 3)) = False Then
            strcon = wswk.Cells(i, 5).Value
            strlstn = wswk.Cells(i, 2).Value
            strfstn = wswk.Cells(i, 3).Value
            With tblttlrw
                .Range(1) = strlstn
                .Range(2) = strfstn
                .Range(3) = wswk.Cells(i, 4).Value
                .Range(4) = wssu.Cells(2, 2).Value
                .Range(5) = wssu.Cells(2, 3).Value
                .Range(6) = strcon
                .Range(7) = wswk.Cells(i, 6)).Value
                .Range(8) = wswk.Cells(i, 7)).Value
                .Range(9) = wswk.Cells(i, 17)).Value
                .Range(10) = wswk.Cells(i, 19)).Value
                .Range(11) = wswk.Cells(i, 20)).Value
            End With
        End If
        Next i

    n = n + 1
    wk = wk + 1

Loop
End Sub