将含空白的多工作表合并至单工作表（VBA问题求助）

嘿，我来帮你搞定这个Excel数据合并的问题！

问题出在哪？ #

你之前的代码只拿到表头，主要是两个原因：

1. 原代码跳过了每个工作表的首行（也就是公司名称），但你其实需要把这个公司名和对应的数据行绑定在一起；
2. CurrentRegion在数据存在空白的时候，经常会识别不全整个数据区域，导致没有实际数据被复制。

修正后的可行代码 #

下面这个VBA脚本完全适配你的需求：它会把每个公司的名称作为单独一列，和对应的数据一起合并到"Combined"工作表，还能处理数据里的空白内容。

Sub CombineCompanies()
    Dim ws As Worksheet
    Dim combinedWs As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim dataRange As Range
    Dim companyName As String
    
    ' 先删掉已有的"Combined"表（避免重复创建报错）
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Combined").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' 创建新的合并工作表
    Set combinedWs = ThisWorkbook.Worksheets.Add
    combinedWs.Name = "Combined"
    
    ' 设置合并表的表头：第一列是公司名称，后面的列对应数据列（你可以根据实际改表头文字）
    combinedWs.Range("A1").Value = "公司名称"
    If ThisWorkbook.Worksheets.Count > 0 Then
        lastCol = ThisWorkbook.Worksheets(2).Cells(2, Columns.Count).End(xlToLeft).Column
        For col = 2 To lastCol + 1
            combinedWs.Cells(1, col).Value = "数据列" & (col - 1)
        Next col
    End If
    
    ' 遍历所有工作表，跳过合并表本身
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Combined" Then
            companyName = ws.Range("A1").Value ' 获取当前工作表的公司名称
            ' 找到当前工作表的最后一行数据（从第2行开始，因为第1行是公司名）
            lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            ' 找到当前工作表的最后一列数据
            lastCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
            
            ' 如果当前工作表有数据（至少第2行有内容）
            If lastRow >= 2 Then
                Set dataRange = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, lastCol))
                ' 找到合并表的下一个空行
                Dim targetRow As Long
                targetRow = combinedWs.Cells(Rows.Count, 1).End(xlUp).Row + 1
                
                ' 把数据复制到合并表的对应位置
                dataRange.Copy Destination:=combinedWs.Cells(targetRow, 2)
                ' 把公司名称批量填充到对应行的A列
                combinedWs.Range(combinedWs.Cells(targetRow, 1), combinedWs.Cells(targetRow + dataRange.Rows.Count - 1, 1)).Value = companyName
            End If
        End If
    Next ws
    
    ' 自动调整合并表的列宽，让内容更清晰
    combinedWs.Columns.AutoFit
    
    MsgBox "数据合并完成啦！"
End Sub

代码怎么用？ #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器；
2. 插入一个新的模块（右键点击项目窗口里的文件，选择「插入」→「模块」）；
3. 把上面的代码粘贴进去，然后按F5运行，或者回到Excel里用开发工具里的宏按钮运行。

关键细节说明 #

• 处理已有合并表：先删掉旧的"Combined"表，避免重复创建导致的错误，同时关闭了弹窗提示让操作更顺畅；
• 绑定公司名称：每个公司的数据行前面都会带上对应的公司名称，不会混乱；
• 准确识别数据范围：用lastRow和lastCol定位数据边界，即使数据里有空白也能完整提取所有内容；
• 自定义表头：你可以把代码里的"数据列1"、"数据列2"改成你实际需要的表头文字。

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