如何编写更高效的跨工作簿工作表单元格区域复制VBA代码？

现有以下VBA代码用于跨不同工作簿复制工作表的全部单元格区域，但使用固定大范围引用"A1:CR1048576"效率偏低，请问如何编写更高效的代码？是否存在更优的替代写法？

原低效代码：

Sub all_col()
Workbooks("xlsb file").Worksheets("sheet name").Range("A1:CR1048576").Copy _
Workbooks("xlsx file").Worksheets("sheet name").Range("A1")
End Sub

核心优化方向 #

避免复制无意义的空白区域，只针对实际有数据的单元格范围操作，同时配合VBA性能开关提升执行速度。

方法1：用UsedRange快速获取已使用区域 #

UsedRange会自动识别工作表中存在数据或格式的单元格范围，省去手动指定大范围的麻烦：

Sub CopyUsedRange()
    ' 关闭屏幕更新、事件触发，大幅提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim sourceWb As Workbook
    Dim sourceWs As Worksheet
    Dim targetWb As Workbook
    Dim targetWs As Worksheet
    
    ' 明确源和目标工作簿、工作表
    Set sourceWb = Workbooks("xlsb file")
    Set sourceWs = sourceWb.Worksheets("sheet name")
    Set targetWb = Workbooks("xlsx file")
    Set targetWs = targetWb.Worksheets("sheet name")
    
    ' 复制已使用区域到目标工作表的A1起始位置
    sourceWs.UsedRange.Copy targetWs.Range("A1")
    
    ' 恢复系统默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

要注意的是：如果工作表中存在残留的单元格格式（比如曾经输入过内容又删除），UsedRange可能会包含这些空白区域，导致范围偏大。

方法2：精准定位数据的最后一行和列 #

通过End或Find方法找到实际有数据的边界，构建完全精准的复制范围：

Sub CopyExactRange()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim copyRange As Range
    
    Set sourceWs = Workbooks("xlsb file").Worksheets("sheet name")
    Set targetWs = Workbooks("xlsx file").Worksheets("sheet name")
    
    ' 从A列底部向上找最后一行有数据的单元格
    lastRow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
    ' 从第一行最右侧向左找最后一列有数据的单元格
    lastCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column
    
    ' 构建精准的复制范围
    Set copyRange = sourceWs.Range(sourceWs.Cells(1, 1), sourceWs.Cells(lastRow, lastCol))
    
    ' 执行复制
    copyRange.Copy targetWs.Range("A1")
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

如果数据区域中间有空行/空列，想获取整个工作表的绝对最后一行，可改用：lastRow = sourceWs.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row，列同理。

方法3：直接赋值（仅复制值时效率最高） #

如果不需要复制公式、格式、批注等，仅复制单元格数值的话，直接赋值是最快的方式：

Sub CopyValuesOnly()
    Application.ScreenUpdating = False
    
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    
    Set sourceWs = Workbooks("xlsb file").Worksheets("sheet name")
    Set targetWs = Workbooks("xlsx file").Worksheets("sheet name")
    
    lastRow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
    lastCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column
    
    ' 直接将源区域的值赋值给目标区域，跳过剪贴板
    targetWs.Range("A1").Resize(lastRow, lastCol).Value = sourceWs.Range("A1").Resize(lastRow, lastCol).Value
    
    ' 如果需要同时复制格式，可添加以下两行：
    ' sourceWs.Range("A1").Resize(lastRow, lastCol).Copy
    ' targetWs.Range("A1").PasteSpecial xlPasteFormats
    
    ' 清除剪贴板状态
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

内容的提问来源于stack exchange，提问作者user20817578