Почему мой код VBA не добавляет данные, а заменяет данные в рабочей книге?

Question

Dim lastrow As Long, lastrow2 As Long

Dim wksSource As Worksheet, wksDest As Worksheet

Dim source1 As Range, target1 As Range, source2 As Range, target2 As Range

Set wksSource = Workbooks("2021 Tracker.xlsm").Worksheets("Sheet3")

Set wksDest = Workbooks("Jan Tracker).xlsm").Worksheets("Sheet1")

lastrow = wksSource.Cells(Rows.Count, 1).End(xlUp).row

lastrow2 = wksDest.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).row

Set source1 = wksSource.Range("A2:A" & lastrow)

Set source2 = wksSource.Range("B2:B" & lastrow)

Set target1 = wksDest.Range("E" & lastrow2)

Set target2 = wksDest.Range("F" & lastrow2)

source1.Copy: target1.PasteSpecial Paste:=xlPasteValues

source2.Copy: target2.PasteSpecial Paste:=xlPasteValues

Этот код заменяет данные в столбцах E и F целевой книги, но я хочу, чтобы он добавлялся к ней. Пожалуйста, помогите.

Answer 1

Ваш код определяет следующую строку в столбце A рабочего листа назначения: lastrow2 = wksDest.Cells (Rows.Count, 1) .End (xlUp) .Offset (1,0) .Row. Но вы вставляете в столбцы E и F. Поэтому последняя строка в столбце A не изменяется, и это приводит к перезаписи.

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

Sub AppendData()

    Dim wksSource As Worksheet                  ' Source sheet
    Dim wksTarget As Worksheet                  ' Target sheet
    Dim Source1 As Range
    Dim Target As Range
    Dim Rl As Long                              ' last row

    Set wksSource = Workbooks("2021 Tracker.xlsm").Worksheets("Sheet3")
    With wksSource
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Source = .Range(.Cells(2, "A"), .Cells(Rl, "B"))
    End With

    Set wksTarget = Workbooks("Jan Tracker).xlsm").Worksheets("Sheet1")
    With wksTarget
        Set Target = .Cells(.Rows.Count, "E").End(xlUp).Offset(1)
    End With

    Source.Copy Deestination:=Target
    Application.CutCopyMode = False
End Sub