# Copying Data From One Sheet to Another Based on Column Headers

#### scohn80215

##### New Member
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!!

### Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

#### MickG

##### MrExcel MVP
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]
[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
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
Can you send an example of the data it fails on !!
Also specify which line of code does the error occurs.

#### scohn80215

##### New Member
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!!

Replies
18
Views
147
Replies
1
Views
156
Replies
7
Views
132
Replies
3
Views
532
Replies
2
Views
172