Copy data from specific named worksheets and combine on a single worksheet

[NHagedorn]

Hello all. First post/attempts at this VBA. I have had no luck copying and pasting every code I could find... either they copy data from every page, have errors, or require some toolkit.

I'm trying to combine all data from two different sheets XPO, and DDD into one sheet CDR. I'm also attempting to add either XPO or DDD to the data row depending on which sheet they came from.

XPO is a copy and paste of sheet OTHER, along with summations.

DDD is also a copy and paste of sheet MORE, along with summations.

XPO and DDD were developed for the purpose of setting up matching data and headers, and summations.

Desired Finished Product SHEET CDR

ID	NAME	Volume	Sheet Name	Q SUM
111	Bob	1	ddd	19
222	May	2	ddd	25
333	Mary	3	ddd	25
444	Frank	4	ddd	37
555	John	5	ddd	26
666	Steve	6	ddd	19
777	Larry	7	ddd	25
888	Walt	8	ddd	18
999	Buck	9	ddd	18
aaa	Smith	11	XPO	12
bbb	Joy	22	XPO	21
ccc	Carly	33	XPO	25
ddd	Kristin	44	XPO	37
eee	Bennett	55	XPO	29
fff	Suzy	66	XPO	25
ggg	Tracy	77	XPO	25
hhh	Amy	88	XPO	16
iii	Wendy	99	XPO	19
jjj	Lauren	12	XPO	32
kkk	Cole	13	XPO	27
lll	Karen	14	XPO	18

<tbody>
</tbody>

DDD SHEET

ID	NAME	Volume	Q Sum
111	Bob	1	19
222	May	2	25
333	Mary	3	25
444	Frank	4	37
555	John	5	26
666	Steve	6	19
777	Larry	7	25
888	Walt	8	18
999	Buck	9	18
0	0	0	0
0	0	0	0
0	0	0	0

<tbody>
</tbody>

MORE SHEET

ID	Item #	NAME	Volume	Q1	Q2	Q3	Q4
111	6685	Bob	1	1	9	4	5
222	5643	May	2	3	8	6	8
333	245242	Mary	3	5	4	7	9
444	7697	Frank	4	3	8	3	23
555	4674	John	5	7	6	6	7
666	2424	Steve	6	4	3	3	9
777	95797	Larry	7	3	5	8	9
888	245245	Walt	8	2	4	6	6
999	244	Buck	9	4	5	3	6

<tbody>
</tbody>

XPO SHEET

ID	NAME	Volume	QSUM
aaa	Smith	11	12
bbb	Joy	22	21
ccc	Carly	33	25
ddd	Kristin	44	37
eee	Bennett	55	29
fff	Suzy	66	25
ggg	Tracy	77	25
hhh	Amy	88	16
iii	Wendy	99	19
jjj	Lauren	12	32
kkk	Cole	13	27
lll	Karen	14	18
0	0	0	0
0	0	0	0

<tbody>
</tbody>

OTHER SHEET

ID	NAME	Address	Volume	Q1	Q2	Q3	Q4
aaa	Smith	street	11	1	2	4	5
bbb	Joy	2 street	22	3	4	6	8
ccc	Carly	3 street	33	5	4	7	9
ddd	Kristin	4 street	44	3	8	3	23
eee	Bennett	5 street	55	7	9	6	7
fff	Suzy	6 street	66	4	5	7	9
ggg	Tracy	7 street	77	3	5	8	9
hhh	Amy	8 street	88	2	4	4	6
iii	Wendy	9 street	99	4	5	3	7
jjj	Lauren	11 street	12	8	7	8	9
kkk	Cole	12 street	13	6	3	9	9
lll	Karen	13 street	14	9	2	3	4

<tbody>
</tbody>

https://drive.google.com/file/d/1MPj33ekjQU564sgNUnx0s7h5V6Hr_Umf/view?usp=sharing

I believe I need the data on the CDR sheet to be values because further manipulation is required.

Thank you for any and all assistance.

 

[NHagedorn]

I will need to do additional manipulations (more cut and paste, summations) to the data on the CDR sheet. So I don't think I can use a VBA that creates a new summary sheet every time which seems to be what most vba's do. Would need it to clear the old data, placing new data.

 

[NHagedorn]

So I think I figured it out/found what I was looking for... Seems to work

Sub Better()
Application.ScreenUpdating = False
Dim wsCDR As Worksheet
Dim LastRowWs As Long
Dim LastRowCDR As Long
Dim StartRowCDR As Long

Set wsCDR = ThisWorkbook.Worksheets("CDR")
LastRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row + 1
wsCDR.Range("A2:R" & LastRowCDR).Clear

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "CDR" And ws.Name <> "Other" And ws.Name <> "More" Then
LastRowWs = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
StartRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
ws.Range("A2:R" & LastRowWs).Copy Destination:=wsCDR.Range("A" & StartRowCDR)
LastRowCDR = wsCDR.Cells(wsCDR.Rows.Count, "A").End(xlUp).Row
wsCDR.Range("E" & StartRowCDR & ":E" & LastRowCDR) = ws.Name
End If
Next
Application.ScreenUpdating = True
End Sub


One issue though.... how do I get it to not copy the zeros from when I initially set up the copy and pastes to XPO and DDD sheet?