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

VBA-根据列标题从多张纸复制列值。

1 个答案: