Question

我使用此代码将数据从ws1复制到列标题的其他ws基础。我需要找到很多列标题，在这段代码中我重复每个col标题数据的代码。我需要一个代码，我输入所有标题名称＆amp;列范围（用于粘贴）在一行中查找并粘贴其他ws中的匹配完整列。

Sheets.add After:=Sheets(Sheets.count)
ActiveSheet.Name = "Filter Data"
Sheets("RawData").Activate
With Sheets("RawData").Rows(1)
'Find "Name,Date,Num,Item,Qty,Sales Price,Amount & etc" in Row 1
    Set na = .Find("Name", lookat:=xlPart)
    Set da = .Find("Date", lookat:=xlPart)
    Set nu = .Find("Num", lookat:=xlPart)
    Set it = .Find("Item", lookat:=xlPart)
    Set qt = .Find("Qty", lookat:=xlPart)
    Set sp = .Find("Sales Price", lookat:=xlPart)
    Set am = .Find("Amount", lookat:=xlPart)
    'If found, copy the column to Sheet (Filter Data)
        Columns(na.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("A1")
        Columns(da.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("B1")
        Columns(nu.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("C1")
        Columns(it.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("D1")
        Columns(qt.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("E1")
        Columns(sp.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("F1")
        Columns(am.Column).EntireColumn.Copy _
        Destination:=Sheets("Filter Data").Range("G1")
    'Else: MsgBox "Name Not Found"
End With

Answer 1

如果以下循环（通过过滤器的运行）适合您，请告诉我：

Sub FilterData()
    Dim Header As Variant
    Dim x As Long, i As Long
    Dim FromColumn As Range

    Header = Array("Name", "Date", "Num", "Item", "Qty", "Sales Price", "Amount")

    x = 1

    For i = LBound(Header) To UBound(Header)
        With ThisWorkbook.Sheets("RawData").Rows(1)
            Set FromColumn = .Find(Header(i), after:=.Cells(1, 1), MatchCase:=False)
        End With

        If Not FromColumn Is Nothing Then
            FromColumn.EntireColumn.Copy Destination:=Sheets("Filter Data").Cells(1, x)

        x = x + 1
        End If
    Next i

End Sub

Vba将标题名称从ws1复制到ws2

1 个答案: