VBA合并多工作表无数据复制问题求助（从A40起始复制）

问题根源分析 #

你的代码没有复制数据，主要是以下几个关键错误导致的：

• 未指定工作表对象，引用错位：原代码里的Cells、Range没有绑定当前遍历的工作表（缺ws.前缀），默认用的是激活的工作表，导致获取的行/列数不是目标工作表的真实数据范围，甚至为空。
• Cells参数顺序颠倒：Cells的语法是Cells(行号, 列号)，你把列号放在了行号的位置，导致选取的区域完全错误，根本选不到A40开始的数据。
• 无数据判断逻辑：当目标工作表A40以下没有数据时，仍执行复制操作，自然没有内容可粘贴。
• 粘贴位置未指定：每次复制后直接粘贴到新表A1，后续数据会覆盖之前的内容，即使有数据也只会保留最后一份。
• 变量未声明类型：ws_new未指定为Worksheet类型，默认是变体类型，存在潜在错误。

修正后的代码 #

Sub merge_cognos()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws_new As Worksheet ' 声明正确的变量类型
    Dim startRow As Long
    Dim startCol As Integer
    Dim lastCol As Long
    Dim lastRow As Long
    Dim targetRow As Long ' 记录新表的粘贴起始行
    
    Set wb = ActiveWorkbook
    Set ws_new = wb.Sheets.Add
    targetRow = 1 ' 初始粘贴行从新表第一行开始
    
    For Each ws In wb.Worksheets
        If ws.Name <> ws_new.Name Then
            startRow = 40
            startCol = 1
            ' 绑定当前工作表，获取真实数据范围
            With ws
                lastRow = .Cells(.Rows.Count, startCol).End(xlUp).Row
                lastCol = .Cells(startRow, .Columns.Count).End(xlToRight).Column
            End With
            
            ' 只有当A40及以下有数据时才执行复制
            If lastRow >= startRow Then
                ' 修正Cells参数顺序，绑定当前工作表
                ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastRow, lastCol)).Copy
                ' 指定粘贴位置，避免覆盖已有数据
                ws_new.Cells(targetRow, startCol).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                ' 更新下一次粘贴的起始行
                targetRow = targetRow + (lastRow - startRow + 1)
            End If
        End If
    Next ws
    
    ' 处理排序和空行删除，直接操作工作表对象，避免选中操作
    With ws_new
        ' 先判断F列是否有数据再排序
        If .Range("F1").End(xlDown).Row > 1 Then
            .Range("F1", .Range("F1").End(xlDown)).Sort Key1:=.Range("F1"), Order1:=xlDescending, Header:=xlNo
        End If
        ' 删除F列为空的行，添加错误处理避免无空行时报错
        On Error Resume Next
        .Columns("F:F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    End With
End Sub

修正关键点说明 #

1. 给所有Cells、Range添加工作表前缀，确保引用的是当前遍历的目标工作表或新表。
2. 修正Cells的参数顺序，符合(行号, 列号)的语法要求。
3. 新增targetRow变量，记录每次粘贴的起始位置，避免数据被覆盖。
4. 添加lastRow >= startRow判断，跳过没有数据的工作表。
5. 替换Selection为直接的工作表对象引用，提升代码稳定性，避免依赖激活状态。
6. 添加错误处理，防止删除空行时因无空行触发报错。

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