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

您可以在以下三个方面进行改进：

您可以定义更大的复制范围，而不必逐行复制和粘贴
如果只需要复制和粘贴值，则最好沿Range(x).Value = Range(y).Value行，这与将值从范围y复制到范围x相同。请注意，这些范围必须完全相同。
始终使用每个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

Answer 2

尝试一下：

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

此vba代码需要花费大量时间来复制和粘贴

2 个答案: