Copy Page Name Multiple Times

[grabrail]

I have a workbook that has repeating multiple worksheets, the sheets are used to collect data about an inspection. Each worksheet is identical. I am trying to collate all information gathered from all completed worksheets into a single worksheet, which is acting like a DB. Ive managed this for the most part but a bit stuck on one last bit.

I have a table in the worksheets that is structured as such

Check No	Defect Found	Serviceable	OCRS Score
1	ghjghj	IP	200
2	hjghj	DP	200

I am collating to a table as such

DPU Number	Check No.	Defect Found	Serviceable	OCRS Score
1​	ghjghj	ghjghj	IP	200​
	hjghj	hjghj	DP	200​
3​	t5trtgrtg	t5trtgrtg	SIP	100​
	gtgtrg	gtgtrg	DP	200​

All this is dummy data

The code I am using to achieve this is:

'DPU Number
    Sheets("GCDefects").Range("B" & lastrowgc + 1 & ":B" & (lastrowgc + 1)).Value = i
    
    'CheckNo
    Worksheets("DPU Report " & i).Range("B38:B" & Rng).Copy
    Sheets("GCDefects").Range("C" & lastrowgc + 1 & ":C" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'SERVICABLE
    Worksheets("DPU Report " & i).Range("G38:G" & Rng).Copy
    Sheets("GCDefects").Range("E" & lastrowgc + 1 & ":E" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'DEFECT Text
    Worksheets("DPU Report " & i).Range("B38:B" & Rng).Copy
    Sheets("GCDefects").Range("D" & lastrowgc + 1 & ":D" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'OCRS
    Worksheets("DPU Report " & i).Range("H38:H" & Rng).Copy
    Sheets("GCDefects").Range("F" & lastrowgc + 1 & ":F" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Each worksheet is called "DPU Report 1" "DPU Report 2", etc. The number comes from a variable called i.

so effectivey each worksheet is called "DPU Report" & i


when I import the code using the code above, each column (apart from DPU Number) is selected on the source worksheet, selecting all rows of data and then copied in, however, I also want the DPU Number to be next to each row so it can be identified which worksheet it came from.

My code, does this for the first entry in the list but then not below, obviously becuase its only copying and pasting each worksheets data once.

My question is how do I get it to repeat the DPU number for each worksheets data so it ends up like this.

DPU Number	Check No.	Defect Found	Serviceable	OCRS Score
1​	ghjghj	ghjghj	IP	200​
1​	hjghj	hjghj	DP	200​
3​	t5trtgrtg	t5trtgrtg	SIP	100​
3​	gtgtrg	gtgtrg	DP	200​

 

[Legacy 143009]

How about cheating?

    'CheckNo
    Worksheets("DPU Report " & i).Range("B38:B" & Rng).Copy
    Sheets("GCDefects").Range("C" & lastrowgc + 1 & ":C" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'DPU Number
    With Sheets("GCDefects")
    .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row + 1 & ":B" & .Cells(Rows.Count, 3).End(xlUp).Offset(1).Row).Value = i
    End With

 

[grabrail]

How about cheating?

    'CheckNo
    Worksheets("DPU Report " & i).Range("B38:B" & Rng).Copy
    Sheets("GCDefects").Range("C" & lastrowgc + 1 & ":C" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'DPU Number
    With Sheets("GCDefects")
    .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row + 1 & ":B" & .Cells(Rows.Count, 3).End(xlUp).Offset(1).Row).Value = i
    End With

Perfect, thank you. Had to alter the code very slightly, and remove the offset(1) as it was putting the data one row too low, but other than this, perfect.

 

[Legacy 143009]

Oh.. I put it there to remove +1 but forgot to remove +1 here:

    'CheckNo
    Worksheets("DPU Report " & i).Range("B38:B" & Rng).Copy
    Sheets("GCDefects").Range("C" & lastrowgc + 1 & ":C" & (lastrowgc + 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'DPU Number
    With Sheets("GCDefects")
    .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row & ":B" & .Cells(Rows.Count, 3).End(xlUp).Offset(1).Row).Value = i
    End With