VBA按照表中列名称跨工作簿提取数据

有多张表格，每张表格的格式不同有的10列，有的12列，且顺序也不同等等，但是都包含需求的几列数据，因此希望可以通过VBA 实现按照汇总表定义好的5个列标题进行数据提取，将文件夹下的每个excel文件中每个表格中与汇总表确认列标题名称相同的内容复制到汇总到汇总表中，不需要计算，只需要提取数据一次汇总到汇总表中
如下示意图，按照列标题BCDA 的顺序一次在每个工作簿中提取对应的数据。

img

该回答通过自己思路及引用到GPTᴼᴾᴱᴺᴬᴵ搜索,得到内容具体如下，可以这样试一下：
以下是一个VBA示例代码，可以实现按照汇总表定义的列标题名称，在每个工作簿中提取对应的数据，然后将数据汇总到汇总表中。

Sub ExtractData()

    Dim folderPath As String
    folderPath = "C:\Data\" '替换为实际文件夹路径
    
    Dim summarySheet As Worksheet
    Set summarySheet = ThisWorkbook.Sheets("汇总表") '替换为实际汇总表工作表名称
    
    Dim headerNames(1 To 5) As String
    headerNames(1) = "B"
    headerNames(2) = "C"
    headerNames(3) = "D"
    headerNames(4) = "A"
    headerNames(5) = "E" '替换为实际需要提取的列标题名称
    
    Dim rowIndex As Integer
    rowIndex = 2 '替换为实际汇总表数据开始行号
    
    Dim fileName As String
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        Dim wb As Workbook
        Set wb = Workbooks.Open(folderPath & fileName)
        For Each ws In wb.Worksheets
            Dim lastRow As Long
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row '替换为实际数据最后一行行号
            Dim headerRow As Range
            Set headerRow = ws.Rows(1)
            Dim headerIndex(1 To 5) As Integer
            For i = 1 To 5
                headerIndex(i) = WorksheetFunction.Match(headerNames(i), headerRow, 0)
            Next i
            For i = 2 To lastRow
                Dim rowData(1 To 5) As Variant
                Dim rowValid As Boolean
                rowValid = True
                For j = 1 To 5
                    If IsError(ws.Cells(i, headerIndex(j))) Then
                        rowValid = False
                        Exit For
                    End If
                    rowData(j) = ws.Cells(i, headerIndex(j)).Value
                Next j
                If rowValid Then
                    summarySheet.Cells(rowIndex, 1).Value = fileName
                    For j = 1 To 5
                        summarySheet.Cells(rowIndex, j + 1).Value = rowData(j)
                    Next j
                    rowIndex = rowIndex + 1
                End If
            Next i
        Next ws
        wb.Close SaveChanges:=False
        fileName = Dir()
    Loop
    
End Sub

这段代码首先定义了一个文件夹路径和汇总表工作表对象，以及需要提取的列标题名称。然后，它使用Dir函数遍历文件夹中的所有Excel文件，并逐个打开每个文件，提取每个工作表中与汇总表确认列标题名称相同的内容，并将数据复制到汇总表中相应的位置。

请根据实际情况修改代码中的文件夹路径、汇总表工作表名称、需要提取的列标题名称、汇总表数据开始行号等参数。

如果以上回答对您有所帮助，点击一下采纳该答案～谢谢

以下答案由GPT-3.5大模型与博主波罗歌共同编写：
这是一个比较复杂的VBA程序，需要涉及到文件夹的读取、遍历文件、打开文件、读取对应的sheet、读取对应的列等等操作。以下是一个示例程序，可以自行修改其中的路径、文件名、列名称等等信息。

Sub extractData()
    Dim folderPath As String, filePath As String, fileName As String
    Dim wb As Workbook, ws As Worksheet, wsSummary As Worksheet
    Dim lastRow As Long, i As Long
    Dim colB, colC, colD, colA, colE As Integer
    
    '设置列名称对应的列数
    colB = 2
    colC = 3
    colD = 4
    colA = 1
    colE = 5
    
    '打开汇总表
    Set wsSummary = ThisWorkbook.Sheets("汇总表")
    
    '设置文件夹路径
    folderPath = "C:\Users\UserName\Documents\"
    
    '列标题名称
    Dim colNameB, colNameC, colNameD, colNameA, colNameE As String
    colNameB = "B列名称"
    colNameC = "C列名称"
    colNameD = "D列名称"
    colNameA = "A列名称"
    colNameE = "E列名称"
    
    '遍历文件夹下的所有文件
    filePath = folderPath & "*.xlsx"
    fileName = Dir(filePath)
    Do While fileName <> ""
        Set wb = Workbooks.Open(folderPath & fileName)
        '遍历工作簿中所有sheet
        For Each ws In wb.Worksheets
            '在当前sheet中查找对应的列标题，找到列数并复制数据
            If findColumn(ws, colNameB) <> -1 And _
               findColumn(ws, colNameC) <> -1 And _
               findColumn(ws, colNameD) <> -1 And _
               findColumn(ws, colNameA) <> -1 And _
               findColumn(ws, colNameE) <> -1 Then
                lastRow = ws.Cells(ws.Rows.Count, colB).End(xlUp).Row
                For i = 2 To lastRow
                    wsSummary.Cells(wsSummary.Rows.Count, colB).End(xlUp).Offset(1, 0).Value = ws.Cells(i, colB).Value
                    wsSummary.Cells(wsSummary.Rows.Count, colC).End(xlUp).Offset(1, 0).Value = ws.Cells(i, colC).Value
                    wsSummary.Cells(wsSummary.Rows.Count, colD).End(xlUp).Offset(1, 0).Value = ws.Cells(i, colD).Value
                    wsSummary.Cells(wsSummary.Rows.Count, colA).End(xlUp).Offset(1, 0).Value = ws.Cells(i, colA).Value
                    wsSummary.Cells(wsSummary.Rows.Count, colE).End(xlUp).Offset(1, 0).Value = ws.Cells(i, colE).Value
                Next i
            End If
        Next ws
        wb.Close
        '继续查找下一个文件
        fileName = Dir
    Loop
End Sub

Function findColumn(ws As Worksheet, colName As String) As Integer
    '查找列标题名称为colName的列数
    findColumn = -1
    For i = 1 To ws.Range("A1").End(xlToRight).Column
        If ws.Cells(1, i).Value = colName Then
            findColumn = i
            Exit Function
        End If
    Next i
End Function

需要注意的是，这个程序仅适用于汇总表和各个工作簿中数据都在第一行开始的情况。如果有其他情况的话，需要自行修改程序中的变量和程序逻辑。
如果我的回答解决了您的问题，请采纳！