Quick way to copy and paste data by columns criteria

[harinsh]

Hi Team,

I am looking for some help in copy and paste the data based on some criteria. For example, I have 175 columns in sheet2 and this might increase or decrease. I have 25 columns in sheet1 this may increase or decrease based on the requirement and all these columns has the same names (99% won't change).

I would like to copy the data from sheet2 based on columns names listed in sheet1. There is one unique column in sheet2 which is claim number. If I paste one claim number in A1 then data related to 25 columns should copy form sheet2 to sheet1 from A5 cell onwards. I can do this from vlookup but column positions may change most of the time.

Can anyone suggest me how to perform this via macro?

Thank you,

 

[DanteAmor]

Try this macro

Change the data in red by your information

Sub CopyColums()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim hRow1 As Long, hRow2 As Long, lc As Long, lr As Long
    Dim b As Range, i As Long
    
    Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
    Set sh2 = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
    
    hRow1 = [COLOR=#ff0000]4 [/COLOR]  'header row on sheet1
    hRow2 = [COLOR=#ff0000]1[/COLOR]   'header row on sheet2
    
    lc = sh1.Cells(hRow1, Columns.Count).End(xlToLeft).Column
    For i = 1 To lc
        Set b = sh2.Rows(hRow2).Find(sh1.Cells(hRow1, i), LookIn:=xlValues, lookat:=xlWhole)
        If Not b Is Nothing Then
            lr = sh2.Cells(Rows.Count, b.Column).End(xlUp).Row
            sh2.Range(sh2.Cells(hRow2 + 1, b.Column), sh2.Cells(lr, b.Column)).Copy sh1.Cells(hRow1 + 1, i)
        End If
    Next
    MsgBox "End"
End Sub

There is one unique column in sheet2 which is claim number. If I paste one claim number in A1 then data related to 25 columns should copy form sheet2 to sheet1 from A5 cell onwards. I can do this from vlookup but column positions may change most of the time.

That part I did not understand. Try the macro and then explain with examples what you mean.