VBA - 根据列标题从多个工作表复制列值。

Question

我还是 VBA 新手，对如何解决这个特定问题有点迷茫。

我在 1 个工作簿中有多个工作表。目标是根据列标题从每个工作表复制数据，因为并非所有列标题在所有工作表中都是统一的。

例如：

主工作表有 6 个列标题，我想提取它们。

表 1 有 8 个列标题，其中一些列的值是空白的。

工作表 2 有 7 个列标题。

表 3 有 10 个列标题等。

我的目标是转到每个工作表，让它遍历每个列标题，如果列标题匹配，则将数据复制/粘贴到主工作表中。

我不知道如何让它查找最后一行并根据标题复制整列。

我在下面拼凑的代码示例：

Sub MasterCombine()

Worksheets("Master").Activate

Dim ws As Worksheet
Set TH = Range("A1:F1")

For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "Master" And ws.Range("A8").Value <> "" Then
    ws.Select

    Range("A8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Worksheets("Master").Activate



For Each cell In TH

If cell.Value = "Subject" Then

cell.EntireColumn.Copy


End If

上面的问题是它复制了整个范围，但没有过滤掉不在主表中的列标题。

任何帮助将不胜感激。

Answer 1

这可能有效。将 Master 标头加载到数组中。然后遍历每个 ws - 然后遍历您的 headers 数组。

Option Explicit

Sub MasterMine()

Dim Master As Worksheet: Set Master = ThisWorkbook.Sheets("Master")
Dim LR1 As Long, LR2 As Long, LC1 As Long, LC2 As Long
Dim ws As Worksheet, Found As Range, i As Long, Arr

LC1 = Master.Cells(1, Master.Columns.Count).End(xlToLeft).Column
Arr = Master.Range(Master.Cells(1, 1), Master.Cells(1, LC1)).Value

For Each ws In Worksheets
    For i = LBound(Arr) To UBound(Arr)
        LC2 = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        Set Found = ws.Range(ws.Cells(1, 1), ws.Cells(1, LC2)).Find(Arr(i, 1), LookIn:=xlWhole)
            If Not Found Is Nothing Then
                LR1 = Master.Cells(Master.Rows.Count, i).End(xlUp).Offset(1).Row
                LR2 = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
                ws.Range(ws.Cells(2, Found.Column), ws.Cells(LR2, Found.Column)).Copy
                    Master.Cells(LR1, i).PasteSpecial xlPasteValues
            End If
    Next i
Next ws

End Sub