求助：多工作表数组非A/B列数据批量复制到Sheet4问题

嘿，我太懂你用UsedRange.Copy踩的坑了——这货经常把那些曾经填过数据后来清空但还留着格式的单元格也算进去，导致复制的范围莫名其妙变大。咱们直接来解决你的需求：精准定位5个工作表里的有效数据（排除A、B列外的空列干扰），然后把它们依次追加到Sheet 4里。

核心思路拆解 #

• 不用UsedRange，改用Cells.Find精准定位最后一行/列的有效数据
• 遍历指定的5个工作表，每次复制后粘贴到Sheet 4的下一个空行，避免覆盖
• 处理边界情况（比如C列及以后无数据的场景）

完整VBA代码实现 #

Sub CopyDataToSheet4()
    Dim destWs As Worksheet
    Dim ws As Worksheet
    Dim sheetNames As Variant
    Dim lastRow As Long
    Dim lastCol As Long
    Dim destLastRow As Long
    Dim dataRange As Range
    
    ' 设置目标工作表（源工作簿的Sheet 4）
    Set destWs = ThisWorkbook.Worksheets("Sheet 4")
    
    ' 替换成你要遍历的5个工作表的名称，按顺序排列
    sheetNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet5", "Sheet6")
    
    ' 遍历每个目标工作表
    For Each sheetName In sheetNames
        On Error Resume Next ' 防止工作表不存在报错
        Set ws = ThisWorkbook.Worksheets(sheetName)
        On Error GoTo 0
        
        If Not ws Is Nothing Then
            ' 找到整个工作表最后一行有数据的单元格（包含A、B列）
            lastRow = ws.Cells.Find(What:="*", _
                                   SearchDirection:=xlPrevious, _
                                   SearchOrder:=xlByRows).Row
            
            ' 找到最后一列有数据的单元格，从C列开始判断
            lastCol = ws.Cells.Find(What:="*", _
                                   SearchDirection:=xlPrevious, _
                                   SearchOrder:=xlByColumns).Column
            
            ' 处理C列及以后无数据的情况，默认取到B列
            If lastCol < 3 Then lastCol = 2
            
            ' 确定要复制的有效数据范围：从A1到最后一行最后一列
            Set dataRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
            
            ' 找到Sheet 4的下一个空行（从A列判断）
            destLastRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 1
            ' 如果Sheet 4是空表，从第一行开始粘贴
            If destLastRow = 2 Then destLastRow = 1
            
            ' 复制数据到Sheet 4（带格式）
            dataRange.Copy destWs.Cells(destLastRow, 1)
            
            ' 如果你只需要复制值（更高效，不带格式），可以替换成下面这行：
            ' destWs.Cells(destLastRow, 1).Resize(dataRange.Rows.Count, dataRange.Columns.Count).Value = dataRange.Value
            
            Set ws = Nothing ' 释放对象
        End If
    Next sheetName
    
    MsgBox "数据批量复制完成！", vbInformation
End Sub

关键细节说明 #

• 精准定位有效范围：Cells.Find会扫描整个工作表，找到最后一个包含内容（文本、数值、公式）的单元格，完全不受残留格式影响。
• 边界情况处理：如果某个工作表只有A、B列有数据，代码会自动把复制范围限定到B列，不会多复制空列。
• 粘贴位置控制：每次粘贴前都会找到Sheet 4的最后一行，确保数据是依次追加，不会覆盖之前的内容。
• 错误防护：加入了On Error Resume Next来避免因工作表不存在导致的代码崩溃，更稳健。

注意事项 #

• 记得把代码里的sheetNames数组替换成你实际要处理的5个工作表名称，顺序就是数据粘贴的顺序。
• 如果工作表是隐藏状态，需要先取消隐藏，或者在代码里添加ws.Visible = xlSheetVisible（放在Set ws = ...之后）。
• 如果需要保留公式和格式，用Copy方法；如果只需要数据值，用Value赋值的方式，运行速度更快。

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