austenr
02-01-2006, 01:59 PM
What I want to do with the code below is this:
Select a,b,c from the row on sheet 1 copy it and paste it to sheet 2. Increment sheet 2 by a row, go back to sheet 1 and copy and paste d,e,f on sheet2.
Sub WriteTestLines()
Dim i As Long, t As Long
Range("A3").Select
For i = 3 To ActiveSheet.Range("A65536").End(xlUp).Row
If Application.WorksheetFunction.CountA(Range("A" & i & ":IV" & i)) > 0 Then
t = t + 1
Range("A:C" & i).Copy Worksheets("Sheet2").Range("A" & t)
t = t + 1
Range("D:F" & i).Copy Worksheets("Sheet2").Range("A" & t)
End If
Next i
End Sub
Select a,b,c from the row on sheet 1 copy it and paste it to sheet 2. Increment sheet 2 by a row, go back to sheet 1 and copy and paste d,e,f on sheet2.
Sub WriteTestLines()
Dim i As Long, t As Long
Range("A3").Select
For i = 3 To ActiveSheet.Range("A65536").End(xlUp).Row
If Application.WorksheetFunction.CountA(Range("A" & i & ":IV" & i)) > 0 Then
t = t + 1
Range("A:C" & i).Copy Worksheets("Sheet2").Range("A" & t)
t = t + 1
Range("D:F" & i).Copy Worksheets("Sheet2").Range("A" & t)
End If
Next i
End Sub