Copying Data From One Sheet to Another Based on Column Headers

scohn80215

New Member
Joined
Mar 16, 2018
Messages
9
Hi Everyone,

This will be my first post. I've researched this problem for hours and I can't find a solution.

I have two worksheets in the same workbook. Worksheet_A - has 20 columns and Worksheet_B - has about 50 columns. I need a macro, or preferably a index/match formula, to copy the data below each column from Worksheet_B and paste it to Worksheet_A whenever the column headers match.

So for example Worksheet_A looks like

Dogs
Cats

<tbody>
</tbody>

And Worksheet_B looks like
Cats
Birds
Dogs
Reptiles
Zoo Animals
Siberian
Love Bird
Husky
Snake
Elephant
Siamese
Parrot
Chihuahua
Frog
Hippo

<tbody>
</tbody>

And I need a formula (or macro) that will leave Worksheet_A looking like:
Dogs
Cats
Husky
Siberian
Chihuahua
Siamese

<tbody>
</tbody>

Worksheet A starts at Row 5 with Column Headers; Worksheet B starts at Row 7 with Column Headers. The number of columns and length of rows in Worksheet_B can change so the formula/macro needs to be dynamic.

Thank so so so much!!
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for results in "Worksheet_A" starting Row 5 from "Worksheet_B" starting row 7.
Code:
[COLOR="Navy"]Sub[/COLOR] MG17Mar17
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] RngAc [COLOR="Navy"]As[/COLOR] Range, r [COLOR="Navy"]As[/COLOR] Range, RngA [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare

[COLOR="Navy"]With[/COLOR] Sheets("Worksheet_B")
    Lst = .Cells("7", Columns.Count).End(xlToLeft).Column
    [COLOR="Navy"]Set[/COLOR] RngAc = .Range("A7", .Cells(7, Columns.Count).End(xlToLeft))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] r [COLOR="Navy"]In[/COLOR] RngAc
      [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Cells(r.Row + 1, r.Column), .Cells(Rows.Count, r.Column).End(xlUp))
        [COLOR="Navy"]If[/COLOR] Not Dic.exists(r.Value) [COLOR="Navy"]Then[/COLOR]
            Dic.Add r.Value, Rng
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] r
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] Sheets("Worksheet_A")
    [COLOR="Navy"]Set[/COLOR] RngA = .Range("A5", .Cells(5, Columns.Count).End(xlToLeft))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] RngA
    [COLOR="Navy"]If[/COLOR] Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR] Dn.Offset(1).Resize(Dic(Dn.Value).Count).Value _
    = Application.Transpose(Application.Transpose(Dic(Dn.Value)))
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

scohn80215

New Member
Joined
Mar 16, 2018
Messages
9
OMG this is incredible! Thank you!

One problem I'm running into. I get a type mismatch (Run-time error '13': Type mismatch) on column G. It copies half the data and then stops. Please help.

Thank you again!
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Can you send an example of the data it fails on !!
Also specify which line of code does the error occurs.
 

scohn80215

New Member
Joined
Mar 16, 2018
Messages
9
Actually, now that I look closer at it, this works perfect. What was happening is there are duplicate column names or mismatches in the column header name.

Truly, I can't tell you how much I appreciate this!!
 

Watch MrExcel Video

Forum statistics

Threads
1,114,230
Messages
5,546,641
Members
410,751
Latest member
Mike Davis 1977
Top