Copy rows to another sheet with transpose

[excelios]

Hi,

with the macro below I am able to copy and paste rows from sheet1 to sheet 2 into column A and B. But if you read the code you can see that I specified:

ActiveCell.Offset(35, 0).Select for sheet2

This is to allow me to copy /paste each row from sheet 1 into sheet 2 every 35 times. Every row in sheet 1 has 35 cells.

What I am trying to achieve here is that I don’t need to use ActiveCell.Offset(35, 0).Select .... but instead the macro is able to recognize that when copy paste for 1 row finishes in column A or B it keeps copying the remaining rows from sheet 1 to sheet 2 exactly a row below where the last paste finished.

Thanks in advance

Sub Test()
 
    Sheets("Sheet2").Select
    Columns("A:B").Select
    Selection.ClearContents
        Sheets("Sheet1").Select
    Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B1").Select
    For Each Row In Sheets("Sheet1").Range("A1:A40").Cells
        Sheets("Sheet1").Select
        'Range("B1").Select
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Offset(0, -1) <> 0 Then
         Range(Selection, Selection.End(xlToRight)).Select
         Selection.Copy
         Sheets("Sheet2").Select
         ActiveCell.Offset(35, 0).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
             False, Transpose:=True
 
        End If
    Next
 
    Sheets("Sheet1").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A1").Select
    For Each Row In Sheets("Sheet1").Range("A1:A40").Cells
        Sheets("Sheet2").Select
        ActiveCell.Offset(35, 0).Select
        If ActiveCell.Offset(0, 1) <> 0 Then
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
             False, Transpose:=True
 
        Else: End
        End If
    Next
End Sub

[StephenR]

Can you attach a sample workbook? Not sure I follow that.