如何用VBA将工作簿各工作表指定范围数据复制到新的MASTER汇总表

原代码问题在于直接读取了工作表当前区域的全部列进行复制，只需替换循环内的复制逻辑，按指定列分块复制即可，以下是完整修改后的可用代码：

Sub Combine2()
    Dim J As Integer, wsNew As Worksheet
    Dim lastRow As Long, pasteRow As Long
    Dim Location As String

    On Error Resume Next
    Set wsNew = Sheets("MASTER")
    On Error GoTo 0
    ' 不存在汇总表则新建
    If wsNew Is Nothing Then
        Set wsNew = Worksheets.Add(Before:=Sheets(1))
        wsNew.Name = "MASTER"
    End If
    
    ' 复制表头
    With Sheets(2)
        .Range("A1:I1").Copy wsNew.Range("B1")
        .Range("R1").Copy wsNew.Range("K1")
        .Range("K1:M1").Copy wsNew.Range("L1")
        .Range("W1:Y1").Copy wsNew.Range("O1")
    End With

    ' 遍历所有工作表汇总数据
    For J = 2 To Sheets.Count
        Location = Sheets(J).Name
        ' 获取当前表有效数据行数
        lastRow = Sheets(J).Cells(Rows.Count, "A").End(xlUp).Row
        ' 无有效数据则跳过
        If lastRow < 2 Then GoTo NextSheet
        
        ' 定位汇总表粘贴起始行
        pasteRow = wsNew.Cells(Rows.Count, "B").End(xlUp).Row + 1
        
        ' 分块复制指定列，仅粘贴数值
        Sheets(J).Range("A2:I" & lastRow).Copy
        wsNew.Range("B" & pasteRow).PasteSpecial xlPasteValues
        
        Sheets(J).Range("R2:R" & lastRow).Copy
        wsNew.Range("K" & pasteRow).PasteSpecial xlPasteValues
        
        Sheets(J).Range("K2:M" & lastRow).Copy
        wsNew.Range("L" & pasteRow).PasteSpecial xlPasteValues
        
        Sheets(J).Range("W2:Y" & lastRow).Copy
        wsNew.Range("O" & pasteRow).PasteSpecial xlPasteValues
        
        ' 填充来源表名到A列
        wsNew.Range("A" & pasteRow & ":A" & pasteRow + lastRow - 2) = Location
NextSheet:
    Next J
    
    ' 格式化汇总表
    With wsNew
        .Range("A1").Value = "Extract Date"
        .Range("A1").Font.Bold = True
        .Columns("A:T").AutoFit
    End With
    
    ' 清空剪贴板取消复制选中状态
    Application.CutCopyMode = False
End Sub

主要修改点 #

• 新增lastRow、pasteRow变量定位有效数据范围和粘贴位置，避免冗余操作
• 移除原全区域复制逻辑，按要求拆分4个区块分别复制到MASTER表对应列，仅粘贴数值避免格式干扰
• 新增空表跳过逻辑，避免无数据的工作表报错
• 修正汇总表引用逻辑，直接使用wsNew变量操作，避免工作表顺序变动导致的错误

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