VBA code for copy paste data based on column headers.

[Balajibenz]

Hi All,

Can someone help me with below requirement.

I have two wrokbooks wk1 and wk2 in the same path as my macro workbook. in Wk1 in sheet1 i have my dump from column A to AX.

in Wk2 in sheet2 i have headers from column A1 to S1 what i am looking for is to copy respective data for each header from sheet1(WK1) and paste it in sheet2(WK2).

Code has to basically look for each header in Sheet1(WK1) and copy the data untill last row (Column "A" last row should be the default reference for copying data). thank you in adavance.

 

[skabdul]

I change Macro for Yours:
Change Workbook name and Sheet name to yours.

Public Sub CopyProjectName()
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim lastCol As Long, lastRow As Long, srcRow As Range
    Dim found1 As Range, found2 As Range, j As Long, Cr1 As String

    Set sourceWS = Workbooks("Workbook1.xlsm").Worksheets("Sheet1") 'Needs to be open
    Set targetWS = Workbooks("Workbook2.xlsm").Worksheets("Sheet1") 'Needs to be open

    With sourceWS
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        For j = 1 To lastCol
        Cr1 = .Cells(1, j).Value
        Set srcRow = .Range("A1", .Cells(1, lastCol))
        Set found1 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)

        If Not found1 Is Nothing Then
            lastCol = targetWS.Cells(1, Columns.Count).End(xlToLeft).Column
            Set srcRow = targetWS.Range("A1", targetWS.Cells(1, lastCol))
            Set found2 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)

            If Not found2 Is Nothing Then
                lastRow = .Cells(Rows.Count, found1.Column).End(xlUp).Row
                .Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Copy
                found2.Offset(1, 0).PasteSpecial xlPasteAll
            End If
        End If
      Next j
    End With
End Sub

it was working but there was multiple sheet in worksheet with same header, and i want data in single sheet one by one as per header given in single sheet.
please help...