Copying from one Worksheet to another repeatedly.

[qh017]

I would like to copy from Cells O4:O9 in Sheet 1. The destination would be a transposed paste result into A1:F1 in Sheet 2. I would like the information to remain their temporarily. Then, if I run the macro again, I would like it to copy the new data in O4:O9, but this time paste into A2:F2 on Sheet 2 (not overwrite previous copy). If I were to run macro a third time, it would copy into A3:F3, and so on.

If Sheet 2 were to be cleared, the macro would paste into A1:F1 again.

I am sure this is possible, but I have been unable to figure it out. I am very new to using macros and VBA. I tried finding a solution online, but was unable to find a resource answering this question.

Thank you in advance for any advice offered.

 

[rlv01]

Possibly something like this.

Sub CopyAndTranspose()
    Dim LastRow As Long
    With Worksheets("Sheet2")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        If Len(.Range("A1").Value) > 0 Then
            LastRow = LastRow + 1
        End If
        Worksheets("Sheet1").Range("O4:O9").Copy
        .Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
End Sub

 

[Vogateer]

Nevermind, it was already answered.

 

[Vogateer]

Well, I already made it, so I might as well offer it, just to give you options:

Sub CopyRangeToNextRow()
    Dim CopyRange As Range, PasteRange As Range
    Set CopyRange = ThisWorkbook.Sheets(1).Range("O4:O9")
    
    Dim PasteRow As Long
    
    With ThisWorkbook.Sheets(2)
        If WorksheetFunction.Sum(.Range("A1:F1")) = 0 Then
            PasteRow = 1
        Else
            PasteRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        
        Set PasteRange = .Range(.Cells(PasteRow, 1), _
                                .Cells(PasteRow, 6))
        PasteRange.Value2 = WorksheetFunction.Transpose(CopyRange)
    End With
        
    End Sub

 

[qh017]

Possibly something like this.

Sub CopyAndTranspose()
    Dim LastRow As Long
    With Worksheets("Sheet2")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        If Len(.Range("A1").Value) > 0 Then
            LastRow = LastRow + 1
        End If
        Worksheets("Sheet1").Range("O4:O9").Copy
        .Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
End Sub

Thank you very much. This worked great