Search for column name in another worksheet and copy matching column data in current worksheet.

[JainM]

I am new to this and facing problem. Like I have single workbook which has worksheets A and B. Right now I am worksheet A and want to run code/Macro that it selects cell value from A1 to A10 from current worksheet one by one and look for same column name in sheet B. If match found then copy data of column and paste in current sheet range starting from H31 cell.

Thanks in advance.
JainM

 

[dpavlina]

Will the columns in sheet B be in the same order, or could they be in any order?

 

[dpavlina]

I believe this macro will do what you want. Try it, and if it isn't what you are looking for, please let me know and I will make another attempt.

Sub ColumnSearch()
'
' ColumnSearch Macro
' Author Dan Pavlina 1/19/2018


'
    Dim lastcol As Integer
    Dim lastrow As Integer
    ColumnNameA = ActiveSheet.Cells(1, 1).Value
    
    Sheets("B").Select
    With ActiveSheet
        lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    For i = 1 To lastcol
        ColumnNameB = ActiveSheet.Cells(1, i)
        If ColumnNameB = ColumnNameA Then
            With ActiveSheet
                lastrow = .Cells(.Rows.Count, i).End(xlUp).Row
            End With
            Range(Cells(2, i), Cells(lastrow, i)).Select
            Selection.Copy
            Sheets("A").Select
            ActiveSheet.Cells(31, 8).Select
            ActiveSheet.Paste
        End If
    Next i
End Sub

 

[NoSparks]

Hello JainM
You are a little sparse with information to know exactly what you're dealing with.
Here's another option

Sub JainM()
    Dim x As Integer
    Dim Rng As Range
    Dim fndHeader As Range
    
'column to start pasting to in Sheet B is H = 8
x = 8
'cycle thru cells A1 to A10 of sheet A
For Each Rng In Sheets("SheetA").Range("A1:A10")
    'look for that value in the column headers of sheet B
    With Sheets("SheetB")
        'assume headers in row 1
        Set fndHeader = .Rows(1).Find(What:=Rng.Value, LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
        If fndHeader Is Nothing Then
            'header not found so do nothing
        Else
            'header was found
            Application.Intersect(.UsedRange, .Columns(fndHeader.Column)).Offset(1).Copy Sheets("SheetA").Cells(31, x)
        End If
    End With
    'increment the column
    x = x + 1
Next Rng
End Sub