Loop for copy cells one by one

[Icesurfer]

Hi All,

I hope i am able to correctly explain my issue.

Sheet1 contains data in range B6:C6 for a few rows down.
i need the first row to be copied to Sheet2, then i add a few rows and go back to Sheet1 to copy the next row. This need to be repeated untill there is no data left in Column B.

It is not possible for me to create a good loop. Can you guys please help.

Example: first copy B6 and C6 to new sheet, then go back and copy B7 and C7 to new sheet. this untill empty cell in B

A B C
6 12 15
7 10 2
8

 

[rpaulson]

try this on a copy of your file

Sub do_it()

sr = 1 'this is the row to start writing data to on sheet2


For r = 6 To Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Sheet2").Range("B" & sr & ":C" & sr).Value = Range("B" & r & ":C" & r).Value
sr = sr + 3
Next r

End Sub

hth,

Ross

 

[Icesurfer]

Thanks for your reply Ross,

That is not exactly what i am looking for.
On Sheet1 i first copy cells B6 and C6, they are pasted in Sheet2 cell B2 and C2. In this time i have a piece of code that adds a unknown number of rows (depending on other values i have on Sheet2).
When this is done, only at that moment we go back to Sheet1 and copy B7 and C6 and paste in Sheet2 cell B3 and C3. again the piece of other code, then again copy paste a new row untill i reached a empty row.

I hope this explain's better.

Gr,

 

[rpaulson]

this??

Sub do_it()

For r = 6 To Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Sheet2").Range("B" & r-4 & ":C" & r-4).Value = Range("B" & r & ":C" & r).Value

call youothermacro

Next r

End Sub

 

[Icesurfer]

Almost there i hope.

I altered you first code to copy and paste with 2 empty rows in between. Now i need to copy paste in Column C new data from sheet3. I can find the first empty cel in C and paste from there. now i want the copy paste in Column C to stop when there is no data in column left.
Pfoeh, difficult to explain..

Here is the end result:

A	B	C
	copy from Sheet1 first row	new entry after copy first row
		new entry after copy first row​ <strike></strike>	<strike></strike>
		new entry after copy first row​ <strike style="background-color: transparent; border-collapse: collapse; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; orphans: 2; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; width: auto; word-spacing: 0px;"></strike><strike></strike>	<strike></strike>
	Sheet1 second row	new entry after copy Second row​ <strike style="background-color: transparent; border-collapse: collapse; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; orphans: 2; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; width: auto; word-spacing: 0px;"></strike><strike></strike>	<strike></strike>
		new entry after copy Second row​ <strike style="background-color: transparent; border-collapse: collapse; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; orphans: 2; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; width: auto; word-spacing: 0px;"></strike><strike style="background-color: transparent; border-collapse: collapse; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; orphans: 2; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; width: auto; word-spacing: 0px;"></strike><strike></strike>	<strike></strike>
		new entry after copy Second row​ <strike style="background-color: transparent; border-collapse: collapse; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; orphans: 2; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; width: auto; word-spacing: 0px;"></strike><strike style="background-color: transparent; border-collapse: collapse; color: rgb(34, 34, 34); font-family: Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif; font-size: 13px; font-style: normal; font-variant: normal; font-weight: 400; letter-spacing: normal; orphans: 2; text-align: left; text-decoration: line-through; text-indent: 0px; text-transform: none; -webkit-text-stroke-width: 0px; white-space: normal; width: auto; word-spacing: 0px;"></strike><strike></strike>	<strike></strike>
		Stop here because no data in colomn B

<tbody>
</tbody>

Here is the code i got so far:


sr = 2
For r = 6 To Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Copy Blad").Range("B" & sr & ":C" & sr).Value = Range("B" & r & ":C" & r).Value
sr = sr + 2
Next r
Sheets("Sheet3").Select
Range("B29:B31").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select


Dim lRow As Long
Dim lCol As Long

'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 4).End(xlUp).Row

'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

Cells(lRow + 1, lCol - 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False