Performance 如何使代码运行得更快？将单元格从一张图纸复制到另一张图纸

我创建了这段代码，它将所有值从“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

---

无需使用循环：

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

part更改为：

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

---

谢谢，现在它工作得更快了，唯一的问题是它将所有单元格从“Sheet1”复制到“Sheet2”——这很好，但也添加了最后一个包含#N/A的单元格