VBA宏合并多工作簿工作表时A2出现空行，求解决方法

你遇到的空行问题根源很明确：新建的合并文件默认自带的Sheet1被你的代码纳入了后续所有处理流程——这个空表被添加了A列，A2被填上了Sheet1，最后合并时这个无数据的空行就留在了最终表里。

修正后的完整代码 #

Option Explicit

Sub Copy_Worksheets()
    Dim fso As Scripting.FileSystemObject
    Dim fol As Scripting.Folder
    Dim f As Scripting.File
    Dim wb As Workbook
    Dim WS As Worksheet
    Dim CombinedFile As Workbook
    Dim LASTROW As Long
    Dim i As Integer
    
    ' 新建合并文件，直接删掉默认的空Sheet1，避免干扰后续操作
    Set CombinedFile = Workbooks.Add
    Application.DisplayAlerts = False
    CombinedFile.Sheets(1).Delete
    Application.DisplayAlerts = True
    
    ' 遍历目标文件夹中的Excel文件
    Set fso = New Scripting.FileSystemObject
    Set fol = fso.GetFolder(ThisWorkbook.Path & "\Folder")
    For Each f In fol.Files
        Debug.Print f.Path
        Set wb = Workbooks.Open(f.Path)
        For Each WS In wb.Worksheets
            ' 排除名为"Sheet"的工作表
            If WS.Name <> "Sheet" Then
                Debug.Print WS.Name
                WS.Copy After:=CombinedFile.Sheets(CombinedFile.Sheets.Count)
            End If
        Next WS
        ' 关闭源文件，不保存任何修改
        wb.Close SaveChanges:=False
    Next f
    
    ' 为每个导入的工作表添加A列并填充Sales Org信息
    For Each WS In CombinedFile.Sheets
        With WS
            ' 插入A列后，原数据从B列开始，用B列判断最后一行更准确
            LASTROW = .Cells(.Rows.Count, "B").End(xlUp).Row
            .Columns(1).Insert
            .Range("A1") = "Sales Org"
            ' 只有存在数据行时才填充，避免空表产生无效赋值
            If LASTROW >= 2 Then
                .Range("A2:A" & LASTROW) = WS.Name
            End If
        End With
    Next WS
    
    ' 合并所有工作表到一个汇总表
    If CombinedFile.Sheets.Count > 0 Then
        ' 新建汇总表放在最前面
        CombinedFile.Sheets(1).Copy Before:=CombinedFile.Sheets(1)
        Dim SummarySheet As Worksheet
        Set SummarySheet = CombinedFile.Sheets(1)
        SummarySheet.Name = "汇总表"
        
        ' 遍历所有源工作表，复制数据到汇总表
        For i = 3 To CombinedFile.Sheets.Count
            With CombinedFile.Sheets(i)
                LASTROW = .Cells(.Rows.Count, "A").End(xlUp).Row
                If LASTROW >= 2 Then
                    .Range("A2", .Cells(LASTROW, .Columns.Count).End(xlToLeft)).Copy _
                        Destination:=SummarySheet.Cells(SummarySheet.Rows.Count, "A").End(xlUp).Offset(1)
                End If
            End With
        Next i
        
        ' 删除所有源工作表
        Application.DisplayAlerts = False
        For i = CombinedFile.Sheets.Count To 2 Step -1
            CombinedFile.Sheets(i).Delete
        Next i
        Application.DisplayAlerts = True
    End If
    
    ' 保存汇总文件并关闭
    CombinedFile.SaveAs ThisWorkbook.Path & "\Folder1 " & Format(Now, "ddmmyyyy hhmmss")
    CombinedFile.Close
End Sub

核心修改点说明 #

1. 移除默认空表：新建合并文件后立刻删除自带的Sheet1，彻底避免它进入后续处理流程。
2. 优化最后一行判断：插入A列后原数据从B列开始，改用B列定位最后一行，避免因原A列无数据导致的判断错误。
3. 增加数据行校验：只有当工作表存在数据行（LASTROW >=2）时才填充A列的工作表名称，防止空表生成无效内容。
4. 重构合并逻辑：新建独立的汇总表，去掉冗余的Select/Activate操作，既提升代码效率，又避免选中操作带来的潜在错误。
5. 保护源文件：关闭源文件时明确指定SaveChanges:=False，防止误修改源文件内容。

这样调整后，合并后的工作表就不会再出现带Sheet1的空行了。

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