Copying data based on header value

[padawan88]

Hi Excel Master,

Every month, I'm require to generate a report. I export the data from a source, put in my excel file and have to arrange the column to meet my layout . My report has a fix layout whereby the column header is fixed (e.g A1 - Name, B1 - Address, etc). The source header text is the same as my layout header text but the arrangement is not (e.g A1 - Address, B1 - Name, etc).

Is there an macro that can help to based on my fixed layout header text (say in Sheet1) copy the data from the source (say in Sheet 2). My source has a lot data header. The macro mechanics that I am thinking is if header text in Sheet1 (my fixed layout) match header text in Sheet 2 (source), copy all the data in the column of the header in Sheet2 and paste to the column in Sheet1.

 

[My Aswer Is This]

Try this:

Sub Copy_Two()
'Modified  7/14/2018  5:55:09 PM  EDT
Application.ScreenUpdating = False
Sheets(1).Activate
Dim i As Long
Dim ans As String
Dim anss As Long
Dim LastrowColumn As Long
Dim SearchString As String
Dim SearchRange As Range
Lastcolumn = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Lastcolumn
    ans = Sheets(1).Cells(1, i).Value
    SearchString = Sheets(1).Cells(1, i).Value
    Set SearchRange = Sheets(2).Cells(1, 1).Resize(, Lastcolumn).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
    anss = SearchRange.Column
    Sheets(2).Columns(anss).Copy Sheets(1).Columns(i)
Next
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

Here is another version that you could also consider.

Sub Copy_Data()
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim c As Range, HeaderFound As Range

  Set ws1 = Sheets("Sheet1")  '<- Check sheet name
  Set ws2 = Sheets("Sheet2")  '<- Check sheet name
  ws1.UsedRange.Offset(1).Clear
  For Each c In Intersect(ws1.UsedRange, ws1.Rows(1))
    Set HeaderFound = ws2.Rows(1).Find(What:=c.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not HeaderFound Is Nothing Then Intersect(HeaderFound.EntireColumn, ws2.UsedRange).Copy Destination:=c
  Next c
End Sub