合并Excel非重复工作表：VBA代码问题及数据合并需求

• 工作簿包含37个工作表，每个表有37至60列（单个工作表内表头唯一），数据行数范围为17至6181行不等
• 跨所有工作表合并表头并去重后，得到189个唯一表头
• 需要新建名为CombinedData的工作表，包含全部189个表头，并将各工作表的行数据按表头名称匹配导入对应列
• 最终合并数据需每周导入SQL数据库，用于查询及生成报表、仪表盘

使用ChatGPT生成的VBA代码无法满足需求，存在数据并排排列、部分数据未完整导入的问题，代码如下：

Sub CombineTabs()
    Dim combinedSheet As Worksheet
    Dim originalSheet As Worksheet
    Dim header As Range
    Dim targetCol As Long

    ' Create a new sheet for the combined data
    Set combinedSheet = Sheets.Add(After:=Sheets(Sheets.Count))
    combinedSheet.Name = "CombinedData"

    ' Loop through all sheets in the original workbook
    For Each originalSheet In ThisWorkbook.Sheets
        ' Loop through each header in the Summary sheet
        For Each header In originalSheet.Range("A1:BI1")
            ' Get the target column in the Combined sheet
            targetCol = targetCol + 1

            ' Copy the header to the Combined sheet
            combinedSheet.Cells(1, targetCol).Value = header.Value

            ' Copy the values from the original sheet to the Combined sheet
            Dim lastRowCombined As Long
            lastRowCombined = combinedSheet.Cells(combinedSheet.Rows.Count, targetCol).End(xlUp).Row

            combinedSheet.Cells(2, targetCol).Resize(originalSheet.UsedRange.Rows.Count - 1, 1).Value = originalSheet.Columns(header.Column).Value

            ' Remove duplicates in the Combined sheet
            lastRowCombined = combinedSheet.Cells(combinedSheet.Rows.Count, targetCol).End(xlUp).Row
            combinedSheet.Range(combinedSheet.Cells(2, targetCol), combinedSheet.Cells(lastRowCombined, targetCol)).RemoveDuplicates Columns:=1, header:=xlNo
        Next header
    Next originalSheet
End Sub

• 不同工作表间存在重复表头，单个工作表内无重复表头

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