этот код VBA занимает так много времени, чтобы скопировать и вставить

Question

Я пытаюсь скопировать столбцы с одного листа на другой, однако копирование занимает так много времени.

Dim lastrow, erow As Long

lastrow = Worksheets("sheet 2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow
    Worksheets("sheet 1").Cells(i, 1).Copy
    erow = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("sheet 1").Paste Destination:=Worksheets("sheet2").Cells(erow + 1, 1)
    Worksheets("sheet 1").Cells(i, 3).Copy
    Worksheets("sheet 1").Paste Destination:=Worksheets("sheet2").Cells(erow + 1, 3)
Next i

Application.CutCopyMode = False
Worksheets("Sheet1").Cells(1, 1).Select

У меня много данных, и я хочу максимально сократить время

Answer 1

Попробуйте это:

Dim lastrow As Long, erow As Long ' Note that in your original code, "As Long" only applied to erow: NOT to lastrow. You need to specify "As..." for each variable individually, otherwise the rest are "As Variant" by default

lastrow = Worksheets("sheet 2").Cells(Rows.Count, 1).End(xlUp).Row

Dim CopyColumn1 as Range, CopyColumn3 As Range
With Worksheets("sheet 1")
    Set CopyColumn1 = .Range(.Cells(2, 1), .Cells(lastrow, 1))
    Set CopyColumn3 = .Range(.Cells(2, 3), .Cells(lastrow, 3))
End With

With Worksheets("sheet2")
    .Range(.Cells(2, 1), .Cells(lastrow, 1)) = CopyColumn1
    .Range(.Cells(2, 3), .Cells(lastrow, 3)) = CopyColumn3
End With

Answer 2

Три вещи, которые вы можете улучшить:

1. Вы можете определить большие диапазоны для копирования, нет необходимости копировать и вставлять строку за строкой

2. Если вам нужно только скопировать и вставить значения, вам лучше сделать что-нибудь по линии Range(x).Value = Range(y).Value, что аналогично копированию значений из диапазона y в диапазон x.Обратите внимание, что эти диапазоны должны иметь одинаковый размер.

3. Всегда обращайтесь как к рабочей книге, так и к рабочему листу с каждым объектом Range.Если вы опустите эти ссылки, VBA вместо этого будет ссылаться на активную книгу (нежелательную).

Sub copypaste()
Dim LRow As Long

With Workbooks(REF)
    LRow = .Sheets("sheet2").Cells(.Rows.Count, "D").End(xlUp).Row 'LRow of col D

    'I am not sure what the ranges are you want to copy and where you want to paste them to
    'these are two exemplifying ranges
    .Sheets("sheet2").Range("A1:D" & LRow).Value = .Sheets("sheet1").Range("A1:D" & LRow).Value    
End With

End Sub