Excel VBA实现某列已使用单元格复制到其他工作表的问题及解决

需求背景 #

我需要实现一个功能：把某工作表中某列的所有已使用单元格复制到另一工作表，并且支持多次运行，能自动适配原列数据的增删操作。

遇到的问题 #

一开始用下面的代码时，触发了Runtime error 91 - 对象变量或With块变量未设置错误：

Public Sheet1 As String, Sheet2 As String
Sub PolicyLanguage()
    Dim Range1 As Range
    Set Range1 = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    ThisWorkbook.Worksheets(Sheet1).Activate
    Range1.Copy Destination:=wb.Sheets(Sheet2)
End Sub

错误原因分析 #

这段代码里有几个关键问题导致了报错：

• 全局变量Sheet1和Sheet2只做了声明但未赋值，相当于空字符串，引用工作表时会直接失效
• wb对象完全没有定义和初始化，直接调用wb.Sheets(Sheet2)必然触发对象未设置的错误
• Range1的定义没有指定所属工作表，默认会引用当前激活的工作表，逻辑上容易出现偏差，尤其是多工作表切换场景

解决方法及优化后的代码 #

后来通过计数含值单元格数量来精准设置复制范围，成功解决了问题，这个方法还能适配宏的其他模块，完美支持数据增删和多次运行：

Dim i As Integer, n As Integer
i = Worksheets("Sheet1").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
n = i + 1
Worksheets("Sheet1").Range("A1:A" & CStr(n)).Copy Destination:=Sheets(NewSheetName).Range("A1:A" & CStr(n))

额外优化建议 #

1. 尽量避免使用Activate/Select方法，直接通过工作表对象引用单元格，代码更稳定且效率更高
2. 如果需要包含公式生成的数值，可以把xlCellTypeConstants换成xlCellTypeConstants + xlCellTypeFormulas
3. 可以加个错误处理，防止列中没有数据时SpecialCells触发错误：

Dim i As Integer, n As Integer
On Error Resume Next
i = Worksheets("Sheet1").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
On Error GoTo 0
If i = 0 Then
    MsgBox "目标列没有数据可复制"
    Exit Sub
End If
n = i + 1
' 这里可以直接复制到目标单元格的起始位置，Excel会自动匹配范围
Worksheets("Sheet1").Range("A1:A" & n).Copy Destination:=Sheets(NewSheetName).Range("A1")

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