如何用无按钮VBA自动复制并转置汇总Excel10个表格数据至指定工作表（去空行）

需求说明 #

• 自动同步同一Excel文件内10个结构一致工作表（Sheet1至Sheet10）的指定区域（B5:E100）数据
• 无需手动点击按钮，实时或打开文件时自动将数据转置汇总至最后一个工作表（Sheet 11）的中央区域
• 汇总过程自动忽略空行

VBA代码实现 #

将以下代码粘贴到Excel的ThisWorkbook模块中（按Alt+F11打开VBA编辑器，双击左侧的ThisWorkbook）：

Private Sub Workbook_Open()
    AutoSummarizeData
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 仅在修改Sheet1-Sheet10的B5:E100区域时触发汇总
    If Sh.Index >= 1 And Sh.Index <= 10 Then
        If Not Intersect(Target, Sh.Range("B5:E100")) Is Nothing Then
            AutoSummarizeData
        End If
    End If
End Sub

Private Sub AutoSummarizeData()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim sourceRange As Range
    Dim destRow As Long
    Dim i As Long, j As Long
    
    ' 指定目标汇总工作表
    Set wsDest = ThisWorkbook.Worksheets("Sheet 11")
    
    ' 清空目标区域旧数据（从B5开始到最后一行）
    wsDest.Range("B5", wsDest.Cells(wsDest.Rows.Count, "XFD")).ClearContents
    
    destRow = 5 ' 汇总数据起始行（可根据中央区域位置调整）
    
    ' 遍历所有源工作表
    For Each wsSource In ThisWorkbook.Worksheets
        If wsSource.Index >= 1 And wsSource.Index <= 10 Then
            Set sourceRange = wsSource.Range("B5:E100")
            
            ' 逐行检查源数据
            For i = 1 To sourceRange.Rows.Count
                ' 跳过全空行
                If Application.CountA(sourceRange.Rows(i)) > 0 Then
                    ' 转置当前行数据到目标工作表
                    For j = 1 To sourceRange.Columns.Count
                        ' 这里列索引4+j对应E列开始，可根据中央区域位置调整
                        wsDest.Cells(destRow, 4 + j).Value = sourceRange.Cells(i, j).Value
                    Next j
                    destRow = destRow + 1
                End If
            Next i
        End If
    Next wsSource
    
    ' 自动适配列宽（可选）
    wsDest.Range(wsDest.Cells(5, 5), wsDest.Cells(destRow - 1, 8)).Columns.AutoFit
End Sub

关键说明 #

1. 自动触发逻辑

   • Workbook_Open：打开文件时自动执行一次汇总，确保初始数据正确
   • Workbook_SheetChange：当Sheet1到Sheet10的B5:E100区域有数据修改时，实时触发汇总，保持数据同步

2. 空行处理

   • 通过Application.CountA(sourceRange.Rows(i)) > 0判断当前行是否有非空单元格，全空行直接跳过

3. 转置与汇总位置

   • 代码中默认将转置后的数据写入Sheet11的E列开始位置（对应4+j），若中央区域位置不同，可修改wsDest.Cells(destRow, 4 + j)中的列索引（比如要从B列开始，改为1+j）
   • 起始行destRow = 5可根据中央表格的实际位置调整

注意事项 #

• 文件需保存为.xlsm格式（启用宏的工作簿），否则代码无法运行
• 确保源工作表是Sheet1至Sheet10，若工作表名称或索引不同，需修改代码中的索引判断条件
• 首次使用需启用宏：打开文件时点击"启用内容"按钮

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