Loop copy and paste

Yes norie. Always b2, just the column will be shifted to the right so that b2 can be used for the new data.

Hi Scabby Dog. I have de-activated the lines that will make the macro loop 500 times because I'm not sure if this is what you wanted. Have a look at the code and let me know if it suits your purpose.

Sub Test()
    'Dim x As Integer
    'For x = 1 To 500
        If Sheets("Sheet2").Range("B2") = "" Then
            Sheets("Sheet1").Range("O1:O21").Copy Sheets("Sheet2").Range("B2")
        ElseIf Sheets("Sheet2").Range("B2") <> "" Then
            Sheets("Sheet2").Range("B2").Select
            Selection.EntireColumn.Insert
            Sheets("Sheet1").Range("O1:O21").Copy Sheets("Sheet2").Range("B2")
        End If
    'Next x
End Sub

I need it to paste special, values as sheet1 contains formulas which it is currently pasting with your code.

Another option would be, instead of shifting the column right, just paste the values into the next column that is empty in the range b2:zz22

Try this one

Sub Test()
    Dim ms As Worksheet
    Application.ScreenUpdating = 0
    Set ms = Sheets("Sheet1")
   
    With Sheets("Sheet2")
        If Sheets("Sheet2").Range("B2") = vbNullString Then
            ms.Range("O1:O21").Resize(500).Copy
            .Range("B2").Resize(500).PasteSpecial xlValues
        Else
            .Range("B2").EntireColumn.Insert
             ms.Range("O1:O21").Resize(500).Copy
            .Range("B2").Resize(500).PasteSpecial xlValues
        End If
       Application.CutCopyMode = 0
    End With
    Set ms = Nothing
    Application.ScreenUpdating = 1
End Sub

Thanks Ab! We are close now. How would I add the loop to make it run 500 times now?

Doesnt work. It inserts an entire column rather than shifting the cells to the right and it only runs once and not 500 times.

I have this which works but doesn't paste values.

Sub Test()
    Dim rng As Range
    
    With ThisWorkbook.Worksheets("Sheet2")
    If Range("B2") = "" Then
        Set rng = Range("B2")
    Else
        Set rng = ThisWorkbook.Worksheets("Sheet2").Range("B2").End(xlToRight).Offset(0, 1)
    End If
    End With
    
    With ThisWorkbook.Worksheets("Sheet1")
    .Range("P3:P22").Copy rng
   
    End With
    
    Set rng = Nothing
    
End Sub

.Range("P3:P22").Copy
    rng.PasteSpecial xlValues

I am not sure which bit you want to repeat, but you can loop 500 times-500 rows

Sub Test()
    Dim rng As Range, i As Long
    
    For i = 1 To 500
    With ThisWorkbook.Worksheets("Sheet2")
    If Range("B2") = "" Then
        Set rng = Range("B2")
    Else
        Set rng = ThisWorkbook.Worksheets("Sheet2").Range("B2").End(xlToRight).Offset(0, 1)
    End If
    End With
    
    With ThisWorkbook.Worksheets("Sheet1")
    .Range("P3:P22").Copy
    rng.PasteSpecial xlValues
   
    End With
    Next i
    Set rng = Nothing
    
End Sub