如何将活动工作表所有可见单元格复制到新工作表？VBA代码求助

需求：将当前工作表中**所有可见数据（包含表头）**复制到新工作表，现有代码存在UsedRange使用问题，同时想了解Selection.PasteSpecial的正确用法，另外新增的定位数据范围的代码不确定是否正确。

现有代码 #

Dim sourceWS As Worksheet
Dim resultWS As Worksheet

Set sourceWS = ActiveWorkbook.ActiveSheet
Set resultWS = Worksheets.Add(After:=Sheets(Sheets.Count))

On Error GoTo Err_Execute

sourceWS.UsedRange.Copy
resultWS.Range("A1").Rows("1:1").Insert Shift:=xlDown

Err_Execute:

If Err.Number = 0 Then
    MsgBox "All have been copied!"
ElseIf Err.Number <> 0 Then
    MsgBox Err.Description
End If

resultWS.Name = "RR案件Filterデータ"

Application.ScreenUpdating = True

新增的范围定位代码（存疑） #

Set columnEnd = sourceWS.Cells.Find(What:="*", After:=sourceWS.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

lastColumn = columnEnd.Columns.Count

sourceWS.Range("A1", Cells(lastRow, lastColumn)).Copy

问题分析与修正方案 #

1. 现有代码的核心问题 #

• UsedRange.Copy会复制整个已使用区域，但如果工作表有筛选，它会连隐藏行/列一起复制，不符合“只复制可见数据”的需求。
• resultWS.Range("A1").Rows("1:1").Insert写法冗余，直接粘贴到新表A1即可，无需插入行。

2. 新增代码的错误点 #

• lastColumn = columnEnd.Columns.Count错误：columnEnd是单个单元格（最后一列的非空单元格），其Columns.Count永远为1，应改为lastColumn = columnEnd.Column。
• Cells(lastRow, lastColumn)未指定工作表，默认指向当前活动表，会导致引用错误，需写成sourceWS.Cells(lastRow, lastColumn)。
• 缺少lastRow的定义与赋值，需先定位最后一行。

3. 正确实现代码（只复制可见数据） #

通过SpecialCells(xlCellTypeVisible)筛选可见区域，结合准确的范围定位实现需求：

Sub CopyVisibleData()
    Dim sourceWS As Worksheet
    Dim resultWS As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim sourceRange As Range
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 定义源工作表与新工作表
    Set sourceWS = ActiveWorkbook.ActiveSheet
    Set resultWS = Worksheets.Add(After:=Sheets(Sheets.Count))
    resultWS.Name = "RR案件Filterデータ"
    
    On Error GoTo Err_Execute
    
    ' 定位源表的实际数据范围（含表头）
    lastRow = sourceWS.Cells.Find(What:="*", After:=sourceWS.Cells(1, 1), _
                                 LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
    lastCol = sourceWS.Cells.Find(What:="*", After:=sourceWS.Cells(1, 1), _
                                 LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column
    Set sourceRange = sourceWS.Range(sourceWS.Cells(1, 1), sourceWS.Cells(lastRow, lastCol))
    
    ' 复制可见区域到新表A1单元格
    sourceRange.SpecialCells(xlCellTypeVisible).Copy Destination:=resultWS.Range("A1")
    
    MsgBox "可见数据已成功复制！"
    
Err_Execute:
    If Err.Number <> 0 Then
        MsgBox "错误：" & Err.Description
    End If
    Application.ScreenUpdating = True
End Sub

4. PasteSpecial的用法说明 #

如果需要选择性粘贴（如仅粘贴值、格式等），可替换复制粘贴代码为：

sourceRange.SpecialCells(xlCellTypeVisible).Copy
resultWS.Range("A1").PasteSpecial Paste:=xlPasteValues ' 仅粘贴值
' 可选参数示例：
' xlPasteValuesAndNumberFormats（值+数字格式）
' xlPasteFormats（仅格式）
' xlPasteFormulas（仅公式）
Application.CutCopyMode = False ' 清除复制状态

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