Copying data row by row from one sheet to another

[justme101]

Hello experts,

This situation is a little tricky for me, so I will try to explain it the best I can. There are 2 sheets we are working with, let's call them "source" and "output". There is data in the source sheet, which starts from Row 5 and is expanding from column A to column F. This needs to be pasted from column B to column G in the output sheet. Now, here is the tricky part. After each row has been pasted, there needs to be 4 more values (phase 2, phase 3, phase 4, phase 5 in the example below) added after it (in column G), and only ten the next row form the source needs to be taken and pasted, with the same 5 values after it. Let me show you an example. Assume the table below is the "output" sheet and is from B to G:

Name	State	Phone No.	Address Line 1	Address Line 2	Test stage
Leo	X	12345	A123	-	Phase 1
					Phase 2
					Phase 3
					Phase 4
					Phase 5
Raphael	Y	78990	B567	-	Phase 1
					Phase 2
					Phase 3
					Phase 4
					Phase 5

This is how the sheet should look after all the data has been copy pasted form the source sheet. I can write the direct copy paste codes but adding the phase 2 to 5 values and then going back and picking the next row to be copied is proving difficult for me. Any help on this would be really helpful. Thank you.

 

[Z51]

This macro may work for you.

Sub justme()
Dim i As Long, n As Long, ce as Range, lastrow As Long, nextrow As Long, wsSrc As Worksheet, wsOut As Worksheet
Set wsSrc = Sheets("Source")
Set wsOut = Sheets("Output")
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
nextrow = wsOut.Range("G" & Rows.Count).End(xlUp).Row + 1
n = 2

For i = 5 To lastrow
    wsOut.Range("B" & nextrow).Resize(1, 6).Value = wsSrc.Range("A" & i).Resize(1, 6).Value
    n = 2
    For Each ce In wsOut.Range("G" & nextrow + 1 & ":G" & nextrow + 4)
        ce.Value = "Phase " & n
        n = n + 1
    Next ce
    nextrow = nextrow + 5
Next i

End Sub

 

[justme101]

This macro may work for you.

Sub justme()
Dim i As Long, n As Long, ce as Range, lastrow As Long, nextrow As Long, wsSrc As Worksheet, wsOut As Worksheet
Set wsSrc = Sheets("Source")
Set wsOut = Sheets("Output")
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
nextrow = wsOut.Range("G" & Rows.Count).End(xlUp).Row + 1
n = 2

For i = 5 To lastrow
    wsOut.Range("B" & nextrow).Resize(1, 6).Value = wsSrc.Range("A" & i).Resize(1, 6).Value
    n = 2
    For Each ce In wsOut.Range("G" & nextrow + 1 & ":G" & nextrow + 4)
        ce.Value = "Phase " & n
        n = n + 1
    Next ce
    nextrow = nextrow + 5
Next i

End Sub

I tested this now, but it doesn't give the desired result. What it is doing instead repeating the phase 2 to phase 5 (not on the correct column too) part from the row after the headers in the output sheet and then again pasting the headers from row 28 and repeating this again till around row 550:

 

[Z51]

There are assumptions in the code based on the limited information available to me. I don't have an exact copy of your workbook.

 

[justme101]

There are assumptions in the code based on the limited information available to me. I don't have an exact copy of your workbook.

No problem. Here are the snapshots for your reference. I am not able to download the XL2BB at this moment to paste the entire workbook. The rows above the headers in both sheet are blank for some other reason, so they will remain there.

 

[Z51]

Based on the layout in your latest pictures (which doesn't match your descriptions in your original post...), this amended code works in my test workbook:

Sub justme()
Dim i As Long, n As Long, ce As Range, lastrow As Long, nextrow As Long, wsSrc As Worksheet, wsOut As Worksheet
Set wsSrc = Sheets("Source")
Set wsOut = Sheets("Output")
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
nextrow = wsOut.Range("F" & Rows.Count).End(xlUp).Row + 1
n = 2

For i = 4 To lastrow
    wsOut.Range("A" & nextrow).Resize(1, 6).Value = wsSrc.Range("A" & i).Resize(1, 6).Value
    n = 2
    For Each ce In wsOut.Range("F" & nextrow + 1 & ":F" & nextrow + 4)
        ce.Value = "Phase " & n
        n = n + 1
    Next ce
    nextrow = nextrow + 5
Next i

End Sub

 

[justme101]

Based on the layout in your latest pictures (which doesn't match your descriptions in your original post...), this amended code works in my test workbook:

Sub justme()
Dim i As Long, n As Long, ce As Range, lastrow As Long, nextrow As Long, wsSrc As Worksheet, wsOut As Worksheet
Set wsSrc = Sheets("Source")
Set wsOut = Sheets("Output")
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
nextrow = wsOut.Range("F" & Rows.Count).End(xlUp).Row + 1
n = 2

For i = 4 To lastrow
    wsOut.Range("A" & nextrow).Resize(1, 6).Value = wsSrc.Range("A" & i).Resize(1, 6).Value
    n = 2
    For Each ce In wsOut.Range("F" & nextrow + 1 & ":F" & nextrow + 4)
        ce.Value = "Phase " & n
        n = n + 1
    Next ce
    nextrow = nextrow + 5
Next i

End Sub

Yeah, I had to prepare a new sample file and take screenshots, so details might have been off. Sorry about that. But, your code works nicely. I do have an amendment to the original query, if you would kindly adjust your code to make the following change, that would be greatly appreciated. The original sample where the columns have Phase 1, Phase 2....was just an example for the query, so in the original scenario the part of "ce.Value = "Phase " & n" and then "n = n + 1", will not be useful (again, not your fault, oversight by me when giving you the sample). So, those are actually 5 different values and look like the one attached here.

You will also see, that the other fields are copied down for the extra rows, to make them come up easily in filters. If that can be accommodated easily here, please help me with that as well. Thank you.

 

[Z51]

Perhaps try:

Sub justme()
Dim i As Long, arr() As Variant, lastrow As Long, nextrow As Long, wsSrc As Worksheet, wsOut As Worksheet
Set wsSrc = Sheets("Source")
Set wsOut = Sheets("Output")
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
nextrow = wsOut.Range("F" & Rows.Count).End(xlUp).Row + 1
arr() = Array("Category", "Age", "Markings", "Reference", "Exclusions")

For i = 4 To lastrow
    wsOut.Range("A" & nextrow).Resize(5, 6).Value = wsSrc.Range("A" & i).Resize(1, 6).Value
    wsOut.Range("F" & nextrow).Resize(5, 1).Value = Application.Transpose(arr)
    nextrow = nextrow + 5
Next i

End Sub