Как я могу скопировать определенные строки из нескольких листов в другой с помощью Excel VBA?

Question

Каждый конец месяца мне приходится копировать данные (скажем, строки 4 в последнюю строку некоторых таблиц (скажем, таблицы 2–7, но на самом деле существует множество таблиц и строк) в таблицу 1, начать вставку со строки 4Рабочий лист 1.

Я изо всех сил стараюсь найти ответ от переполнения стека и других веб-сайтов. Поскольку я являюсь неспециалистом VBA Excel, я не могу на самом деле настроить этот код для своего случая.

Я был бы очень признателен, если бы кто-нибудь мог мне помочь. Спасибо.

Ниже приведен неудачный пример, который я делаю сам

Sub test1()
    Workbooks.Open Filename:="file location"
    Worksheets(2).Activate
    a = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    For a1 = 3 To a        
        Worksheets(2).Row(a1).Copy
        Worksheets(1).Activate
        Worksheets(1).Rows(a).PasteSpecial
    Next
End Sub

Спасибо, Алекс. Я исправилкод по ссылке на ваш. Впоследствии я обнаружил, что написание моего кода, как показано ниже, не очень эффективно, хотя нужно скопировать около 100 рабочих листов и вставить 7 основных списков. Ниже приведен пересмотренный код, который кажется более эффективным для написанияФункция «сделать, если»? Скажем, как только VBA скопировал рабочие листы 2-10 строк 4 на рабочий лист 1, затем запустите копирование рабочих листов 12-21 строк 4 на рабочий лист 21

Sub test2()

'
Workbooks.Open Filename:="file location"

Worksheets(2).Rows("1:3").Copy Destination:=Worksheets(1).Rows(1)
Worksheets(1).Range("A:AG").ColumnWidth = 20
Worksheets(1).Range("AD:AD").ColumnWidth = 65
'
'
Worksheets(2).Activate
a = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row

Set rangeToCopy = Worksheets(2).Range(Cells(4, 1), Cells(a, 33))
rangeToCopy.Copy
Dim lastRow As String
lastRow = Worksheets(1).Cells(Rows.Count, "e").End(xlUp).Row + 1
Worksheets(1).Cells(lastRow, 1).PasteSpecial ' lastRow,1

Application.CutCopyMode = False
Set rangeToCopy = Nothing
'
'
'
Worksheets(3).Activate
b = Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Row

Set rangeToCopy = Worksheets(3).Range(Cells(4, 1), Cells(b, 33))
rangeToCopy.Copy
Dim lastRow2 As String
lastRow2 = Worksheets(1).Cells(Rows.Count, "e").End(xlUp).Row + 1
Worksheets(1).Cells(lastRow2, 1).PasteSpecial ' lastRow2,1

Application.CutCopyMode = False
Set rangeToCopy = Nothing

.....to be continued
End Sub

Answer 1

Копировать и вставлять данные Range проще без каких-либо циклов, например:

Set rangeToCopy= worksheets(1).Range(Cells(1, 1), Cells(a, 100))'insert number of columns instead of 100
rangeToCopy.Copy
worksheets(2).Cells(1, 1).PasteSpecial Paste:=xlPasteValues' 1,1 - row, column where u want to insert your data