VBA实现多工作表指定列非空内容合并至新工作表单列

我帮你写了一段针对性的VBA代码，完美匹配你的需求：按A→A1→B→B1的顺序，把每个工作表指定列的非空内容连续复制到新工作表C的同一列，中间不会留空行。

完整代码 #

Sub MergeSpecifiedColumnsToSheetC()
    Dim ws As Worksheet
    Dim targetWs As Worksheet
    Dim sourceSheets As Variant
    Dim sourceColumns As Variant
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Integer
    
    ' 定义要处理的工作表名称和对应的指定列（示例用列A，你可改成需要的列，比如"E"、"G"等）
    sourceSheets = Array("A", "A1", "B", "B1")
    sourceColumns = Array("A", "A", "A", "A") ' 每个工作表对应目标列，可单独修改
    
    ' 创建或获取目标工作表C
    On Error Resume Next
    Set targetWs = ThisWorkbook.Worksheets("C")
    If Err.Number <> 0 Then
        Set targetWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        targetWs.Name = "C"
    End If
    On Error GoTo 0
    
    ' 初始化目标行（要跳过表头就改成2）
    targetRow = 1
    
    ' 循环处理每个源工作表
    For i = LBound(sourceSheets) To UBound(sourceSheets)
        ' 检查源工作表是否存在
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(sourceSheets(i))
        If Err.Number = 0 Then
            ' 获取源工作表指定列的最后一行
            lastRow = ws.Cells(ws.Rows.Count, sourceColumns(i)).End(xlUp).Row
            
            ' 复制非空单元格到目标表
            ws.Range(sourceColumns(i) & "1:" & sourceColumns(i) & lastRow).SpecialCells(xlCellTypeConstants).Copy _
                Destination:=targetWs.Cells(targetRow, 1)
            
            ' 更新目标行到下一个空行
            targetRow = targetWs.Cells(targetWs.Rows.Count, 1).End(xlUp).Row + 1
        Else
            MsgBox "工作表 " & sourceSheets(i) & " 不存在，已跳过该表处理"
        End If
        On Error GoTo 0
    Next i
    
    MsgBox "合并完成！内容已整理到工作表C中"
End Sub

关键说明 #

• 自定义指定列：你可以修改sourceColumns数组，比如A表要复制列B、A1表复制列D，就改成sourceColumns = Array("B", "D", "A", "C")，灵活适配你的实际需求。
• 跳过表头：如果源工作表有表头不需要复制，把targetRow = 1改成targetRow = 2，同时把复制范围里的"1:"改成"2:"即可。
• 错误防护：代码加了工作表存在性检查，要是某个工作表找不到，会弹出提示并跳过，避免程序直接崩溃。
• 非空筛选：用SpecialCells(xlCellTypeConstants)确保只复制非空的常量单元格；如果要包含公式生成的内容，可以改成xlCellTypeVisible（不过得确保没有隐藏行）。

使用步骤 #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器
2. 在左侧工程窗口右键点击你的工作簿，选「插入」→「模块」
3. 粘贴上面的代码，修改sourceColumns为你实际需要的列
4. 按下F5运行，或者回到Excel界面，在「开发工具」→「宏」里找到MergeSpecifiedColumnsToSheetC执行即可

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