merge data from multiple sheets into single sheet - different rows, same columns

jocl1 · Feb 28, 2015

I'm a newbie to macros I'm afraid. I'm using Excel 2011. I'm trying to merge data from 4 sheets into a single sheet. I've looked at a number of macros but can't seem to find one I can use. Problem is I really don't feel confident enough to adapt existing ones.

This is what I have and would like to do:

1. I have 4 sheets with different columns (characteristics) and rows (items)

Number of rows (excluding top row of column headers):
Sheet 1: 1204
Sheet 2: 1159
Sheet 3: 1011
Sheet 4: 752 (& 128 columns!)

2. The first column in each sheet contains the unique item ID
3. Each sheet has the same column headers and the different sets of data are listed below the relevant column
4. This is the bit I'm really stuck on:
Not all the items (rows) appear in each sheet. Therefore I don't have a complete set of characteristic data for each item (row) across all the sheets. Unfortunately, there are no gaps between the rows, so I can't just do a simple copy & paste!

I have something like this (actual headers currently pretty long!):

Sheet 1:

ID	Size	Weight
XX01/001	84	1
XX01/009	84	1
XX03/014	71	2
XX05/031	75	1

Sheet 2:

ID	DDL
XX01/001	100
XX03/011	100
XX03/014	95

Sheet 3:

ID	AT	PET	RT	CT
XX01/001	Yes	Yes
XX01/009	Yes	No	Yes	No
XX03/011	No
XX03/014	Yes		Yes
XX05/031	Yes	No	No	No

Sheet 4:

ID	ADDT	DDT	RET	GaLa	Br	SXTP	SXTP_OTH
XX01/009	15/07	16/07		GA	R	M
XX03/014	21/06	23/06	Yes	GA	L	O	T
XX03/021	13/01	14/01		GA	R	W
XX05/031	01/12	04/12		LA	R	W

I would like to have:

ID	Size	Weight	DDL	AT	PET	RT	CT	GaLa	Br	SXTP	SXTP_OTH
XX01/001	84	1	100	Yes	Yes
XX01/009	84	1		Yes	No	Yes	No	GA	R	M
XX03/011			100
XX03/014	71	2	95	Yes		Yes		GA	L	O	T
XX03/021								GA	R	W
XX05/031	75	1		Yes	No	No	No	LA	R	W

etc...

I hope this makes sense!

Any help would be very gratefully received as I feel like I've spent days and days trying to sort this out and really don't want to rely on hand inputting stuff!

jocl1

VeBeYay · Feb 28, 2015

Hi,
The way I've approached this is to first create list of all ID's, then make this a unique list, then get data from each sheet for each ID.
Hopefully it gives you a starter for ten.

Code:

Option Explicit

Sub CreateMasterSht()

Dim LRow1, LRow2, LRow3, i As Integer
Dim sID As String
Dim rCell As Range

Application.ScreenUpdating = False

LRow1 = Worksheets("Sheet1").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow2 = Worksheets("Sheet2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow3 = 2

Worksheets("Sheet1").Cells(2, 1).Resize(LRow1).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht1
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet2").Cells(2, 1).Resize(LRow2).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht2
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet3").Cells(2, 1).Resize(LRow2).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht3
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet4").Cells(2, 1).Resize(LRow2).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht4
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
                                                                'Get unique ID list
Worksheets("Sheet5").Range("A2:A" & LRow3).RemoveDuplicates Columns:=1, Header:=xlNo
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row

                                                                'Copy data for each unique ID
For i = 2 To LRow3
    sID = Worksheets("Sheet5").Cells(i, 1)
    With Worksheets("Sheet1")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 2).Copy
            Worksheets("Sheet5").Cells(i, 2).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet2")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Copy
            Worksheets("Sheet5").Cells(i, 4).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet3")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 4).Copy
            Worksheets("Sheet5").Cells(i, 5).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet4")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 7).Copy
            Worksheets("Sheet5").Cells(i, 9).PasteSpecial xlPasteAll
        End If
    End With
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

jocl1 · Feb 28, 2015

Hi VeBeYay,

Thanks so much for such a swift response. I've tried running it but Excel keeps crashing.

Not sure what's going wrong.

VeBeYay said:

Hi,
The way I've approached this is to first create list of all ID's, then make this a unique list, then get data from each sheet for each ID.
Hopefully it gives you a starter for ten.

Code:

Option Explicit

Sub CreateMasterSht()

Dim LRow1, LRow2, LRow3, i As Integer
Dim sID As String
Dim rCell As Range

Application.ScreenUpdating = False

LRow1 = Worksheets("Sheet1").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow2 = Worksheets("Sheet2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow3 = 2

Worksheets("Sheet1").Cells(2, 1).Resize(LRow1).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht1
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet2").Cells(2, 1).Resize(LRow2).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht2
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet3").Cells(2, 1).Resize(LRow2).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht3
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet4").Cells(2, 1).Resize(LRow2).Copy
Worksheets("Sheet5").Cells(LRow3, 1).PasteSpecial xlPasteAll    'Copy ID's from sht4
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
                                                                'Get unique ID list
Worksheets("Sheet5").Range("A2:A" & LRow3).RemoveDuplicates Columns:=1, Header:=xlNo
LRow3 = Worksheets("Sheet5").Cells(Cells.Rows.Count, 1).End(xlUp).Row

                                                                'Copy data for each unique ID
For i = 2 To LRow3
    sID = Worksheets("Sheet5").Cells(i, 1)
    With Worksheets("Sheet1")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 2).Copy
            Worksheets("Sheet5").Cells(i, 2).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet2")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Copy
            Worksheets("Sheet5").Cells(i, 4).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet3")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 4).Copy
            Worksheets("Sheet5").Cells(i, 5).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet4")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 7).Copy
            Worksheets("Sheet5").Cells(i, 9).PasteSpecial xlPasteAll
        End If
    End With
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

VeBeYay · Feb 28, 2015

Ah, bug hunting - always the best part.
You can try stepping through the code 1 step at a time using F8 to see where the glitches are.
Points maybe - do the sheet names I used match yours? Do all your data tables start in column 1, row 2? I'm on Excel 2010 so shouldn't be a version prob (but you never know).
Good luck.

jocl1 · Feb 28, 2015

Bug hunting - the best part indeed! Thanks for the help and the code! I've manually made a complete list of all the IDs (thanks for the tip) using copy & paste plus remove duplicates. Will try your second bit of code plus the bug hunt.

Thanks once again.

VeBeYay said:
Ah, bug hunting - always the best part.
You can try stepping through the code 1 step at a time using F8 to see where the glitches are.
Points maybe - do the sheet names I used match yours? Do all your data tables start in column 1, row 2? I'm on Excel 2010 so shouldn't be a version prob (but you never know).
Good luck.

jocl1 · Feb 28, 2015

So I changed the code and edited to fit the actual numbers of columns in each sheet. It works for the first row but doesn't seem to want to continue... Just in case you were still online or someone else could help. I guess I've removed a key piece of code! See below:

Code:

Option Explicit


Sub CreateMasterSht()


Dim LRow1, LRow2, LRow3, i As Integer
Dim sID As String
Dim rCell As Range


Application.ScreenUpdating = False


LRow1 = Worksheets("Sheet1").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow2 = Worksheets("Sheet2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
LRow3 = 2


                                                                'Copy data for each unique ID
For i = 2 To LRow3
    sID = Worksheets("Sheet5").Cells(i, 1)
    With Worksheets("Sheet1")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 2).Copy
            Worksheets("Sheet5").Cells(i, 2).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet2")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 1).Copy
            Worksheets("Sheet5").Cells(i, 4).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet3")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 7).Copy
            Worksheets("Sheet5").Cells(i, 5).PasteSpecial xlPasteAll
        End If
    End With
    With Worksheets("Sheet4")
        .Activate
        Set rCell = .Columns(1).Find(what:=sID)
        If Not rCell Is Nothing Then
            .Cells(rCell.Row, 2).Resize(, 127).Copy
            Worksheets("Sheet5").Cells(i, 12).PasteSpecial xlPasteAll
        End If
    End With
Next


Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub

jocl1 said:
Bug hunting - the best part indeed! Thanks for the help and the code! I've manually made a complete list of all the IDs (thanks for the tip) using copy & paste plus remove duplicates. Will try your second bit of code plus the bug hunt.

Thanks once again.

hiker95 · Feb 28, 2015

jocl1,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

The below macro makes two passes on all the raw data worksheets, and, uses the Scripting.Dictionary on the first pass to get all the unique ID numbers.

Here is another macro for you to consider, based on the raw data screenshots you have displayed:

Sample raw data worksheets:

Excel 2007

A

B

C

1

ID

Size

Weight

2

XX01/001

84

1

3

XX01/009

84

1

4

XX03/014

71

2

5

XX05/031

75

1

6

1204

Excel 2007

A

B

1

ID

DDL

2

XX01/001

100

3

XX03/011

100

4

XX03/014

95

5

1159

Excel 2007

A

B

C

D

E

1

ID

AT

PET

RT

CT

2

XX01/001

Yes

3

XX01/009

Yes

No

Yes

No

4

XX03/011

No

5

XX03/014

Yes

6

XX05/031

Yes

No

7

1011

Excel 2007

A

B

C

D

E

F

G

H

1

ID

ADDT

DDT

RET

GaLa

Br

SXTP

SXTP_OTH

2

XX01/009

15/07

16/07

GA

R

M

3

XX03/014

21/06

23/06

Yes

GA

L

O

T

4

XX03/021

13/01

14/01

GA

R

W

5

XX05/031

12/01

12/04

LA

R

W

6

752

After the macro in a new worksheet Results:

Excel 2007

A

B

C

D

E

F

G

H

I

J

K

L

1

ID

Size

Weight

DDL

AT

PET

RT

CT

GaLa

Br

SXTP

SXTP_OTH

2

XX01/001

84

1

100

Yes

3

XX01/009

84

1

Yes

No

Yes

No

GA

R

M

4

XX03/011

100

No

5

XX03/014

71

2

95

Yes

GA

L

O

T

6

XX03/021

GA

R

W

7

XX05/031

75

1

Yes

No

LA

R

W

8

Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Sub MergeSheets()
' hiker95, 02/28/2015, ME839180
Dim wr As Worksheet, ws As Worksheet
Dim a As Variant, i As Long, c As Long
Dim lr As Long, lc As Long, nr As Long, r As Range, t As Range, d As Range
Application.ScreenUpdating = False
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
Set wr = Worksheets("Results")
With wr
  .UsedRange.Clear
  With .Cells(1, 1).Resize(, 12)
    .Value = Array("ID", "Size", "Weight", "DDL", "AT", "PET", "RT", "CT", "GaLa", "Br", "SXTP", "SXTP_OTH")
    .Font.Bold = True
  End With
End With
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Results" And ws.Name <> "Instructions" Then
    With ws
      lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
      For Each d In ws.Range("A2:A" & lr)
        Set r = wr.Columns(1).Find(d, LookAt:=xlWhole)
        If r Is Nothing Then
          nr = wr.Cells(wr.Rows.Count, "A").End(xlUp).Row + 1
          wr.Cells(nr, 1) = d
        End If
      Next d
    End With
  End If
Next ws
wr.Range("A2:A" & nr).Sort key1:=wr.Range("A2"), order1:=1
For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Results" And ws.Name <> "Instructions" Then
    With ws
      lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
      lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
      a = ws.Range(.Cells(1, 1), .Cells(lr, lc))
      For i = 2 To UBound(a, 1)
        For c = 2 To UBound(a, 2)
          If a(i, c) <> "" Then
            Set r = wr.Columns(1).Find(a(i, 1), LookAt:=xlWhole)
            Set t = wr.Rows(1).Find(a(1, c), LookAt:=xlWhole)
            If (Not r Is Nothing) * (Not t Is Nothing) Then
              wr.Cells(r.Row, t.Column).Value = a(i, c)
            End If
          End If
        Next c
      Next i
    End With
    Erase a
  End If
Next ws
With wr
  .UsedRange.Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the MergeSheets macro.

hiker95 · Feb 28, 2015

jocl1,

Sheet 4: 752 (& 128 columns!)

I assume by the above quote, that there could be many more titles in the results worksheet instead of just 12.

If so, then we will have to see the actual worksheet that contains the 128 columns.

You can upload your workbook to Box Net,

sensitive data changed

mark the workbook for sharing

and provide us with a link to your workbook.

jocl1 · Mar 1, 2015

Dear hiker95,

Thanks for your help and such a swift response! I'm afraid the whole workbook contains sensitive data and I can't upload it.

I tried changing all the header values to numbers. But it didn't work. Perhaps letters would be better? AA, BB, CC? The first column is always the ID column. That would give the following column headers: sheet 1 = AA (IDs), BB, CC; sheet 2 = AA, DD; sheet 3 = AA, EE to KK; sheet 4 = AA, LL to whatever the 138th would be!

Just a thought. Thanks again for your help.

I forgot add to my first post that as well as Excel 2011, I'm also on a Mac.

hiker95 said:
jocl1,

I assume by the above quote, that there could be many more titles in the results worksheet instead of just 12.

If so, then we will have to see the actual worksheet that contains the 128 columns.

You can upload your workbook to Box Net,

sensitive data changed

mark the workbook for sharing

and provide us with a link to your workbook.

hiker95 · Mar 1, 2015

jocl1,

Thanks for your help and such a swift response! I'm afraid the whole workbook contains sensitive data and I can't upload it.

You are very welcome, but, I will not be able to assist you because of the next quote.

I'm also on a Mac.

I have no experience with a Mac.

In the future when asking for help, you should add to your new thread title on a Mac.

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.

merge data from multiple sheets into single sheet - different rows, same columns

jocl1

New Member

Excel Facts

VeBeYay

Board Regular

jocl1

New Member

VeBeYay

Board Regular

jocl1

New Member

jocl1

New Member

hiker95

Well-known Member

hiker95

Well-known Member

jocl1

New Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

merge data from multiple sheets into single sheet - different rows, same columns

New Member

Excel Facts

Board Regular

New Member

Board Regular

New Member

New Member

Well-known Member

Well-known Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock