【Excel VBA编程】数据整理快人一步:多张结构相同的表格合并

Set wsSource = ThisWorkbook.Worksheets("Sheet9") ' 根据实际表名修改

Sub MergeTables()    Dim wsSource As Worksheet, wsDest As Worksheet    Dim firstCell As Range, tableRng As Range, dataRng As Range    Dim destRow As Long, i As Long, startCol As Long, lastCol As Long    Set wsSource = ThisWorkbook.Worksheets("Sheet9") ' 根据实际表名修改    '添加工作表，名字为“合并结果”    Set wsDest = ThisWorkbook.Worksheets.Add    wsDest.Name = "合并结果"    destRow = 2    '默认所有表格都从第一行开始    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column    startCol = 1    '循环处理每张表格    Do While startCol <= lastCol        Set firstCell = wsSource.Cells(1, startCol)        '跳过空列        If Application.CountA(firstCell) = 0 Then            startCol = startCol + 1            GoTo ContinueLoop        End If        Set tableRng = firstCell.CurrentRegion        '添加表头信息（包括格式）        tableRng.Cells(1, 1).Copy Destination:=wsDest.Cells(1, 1)        tableRng.Cells(1, 2).Copy Destination:=wsDest.Cells(1, 2)        '获取数据区域，排除表头        Set dataRng = tableRng.Resize(tableRng.Rows.Count - 1, tableRng.Columns.Count).Offset(1, 0)        If Application.CountA(dataRng) > 0 Then            ' 复制数据到目标位置            dataRng.Copy Destination:=wsDest.Cells(destRow, 1)            destRow = destRow + dataRng.Rows.Count        End If        '更新起始列位置        startCol = tableRng.Columns(tableRng.Columns.Count).Column + 1ContinueLoop:    Loop    MsgBox "合并完成！共合并了 " & (destRow - 1) & " 行数据。", vbInformationEnd Sub