Vba to copy data base on col header name from ws1 to ws2

[FaizanRoshan88]

I use this code to copy data from ws1 to other ws base of columns header. I need to find lot of columns header, in this code i repeat code for each col header data. what I need a code where i enter all header name & columns range (for paste) in one line to find and paste match complete columns in other 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"
EndWith

 

[Monty]

Hello Faizan

Hope this helps...

Note your header names mention in "Main sheet" from 1 to 8 based on the number of headers you have.

Macro will check first header in the main sheet and goes to raw data sheet copy it and paste it in Filter data tab...

Sub Test()

Dim y,ws,sh,MS As Workbook
'Setting your sheet names
Set sh =Sheets("Filter Data")
Set ws = Sheets("Raw Data")
Set Ms=Sheets("Main Sheet")


'Declaration of variables

Dim i As Integer, searchedcolumn As Integer, searchheader As Object

Ms.Activate
For i = 1 To 8  'Change number of header's here 
    Set searchheader = ws.Cells(1, i)   
    searchedcolumn = 0

    On Error Resume Next
    searchedcolumn = sh.Rows(1).Find(what:=searchheader.Value, lookat:=xlWhole).Column
    On Error GoTo 0

    If searchedcolumn <> 0 Then
        ws.Columns(searchedcolumn).Copy Destination:=searchheader   
    End If
Next i

Msgbox "Process completer"

End Sub