我怎样才能让我的代码更快运行？ 将单元格从一个表格复制到另一个

我已经创build了这个代码，它将从Sheet1中复制所有值 – 从A2单元格开始到Sheet2中列1的第一个空行。

如果需要复制更多的单元格，则会运行很长时间。 有没有可能让它跑得更快？

谢谢

Sub CopyCells() Dim CopyRow As Long CopyRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row 'find last first empty cell in destination sheet 'Sheets("Sheet1").Range("A2").Copy Destination:=Sheets("Sheet2").Range("A" & CopyRow + 1) Call turn_on_off(False) For I = 2 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Sheets("Sheet1").Range("A" & I).Copy Destination:=Sheets("Sheet2").Range("A" & CopyRow + I - 1) Next I Call turn_on_off(True) End Sub Public Sub turn_on_off(mode As Boolean) With Application .Calculation = IIf(mode = True, xlCalculationAutomatic, xlCalculationManual) .ScreenUpdating = mode End With End Sub 

Answer 1

没有必要使用循环：

 Sub CopyCells() Dim CopyRow As Long Dim lastrow As Long Dim sh1 As Worksheet, sh2 As Worksheet Call turn_on_off(False) Set sh1 = ThisWorkbook.Worksheets("Sheet1") Set sh2 = ThisWorkbook.Worksheets("Sheet2") lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row CopyRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row sh2.Range("A" & CopyRow + 1).Resize(lastrow - 1).Value = _ sh1.Range("A2:A" & lastrow).Value Call turn_on_off(True) End Sub 

Range.Value=Range.Value Copy/Paste速度要快得多，但是它只复制值（没有格式化）。 如果您还需要复制格式， Range.Value=Range.Value部分更改为：

 sh1.Range("A2:A" & lastrow).Copy Destination:=sh2.Range("A" & CopyRow + 1)