Sub Main() Dim i As Long On Error Resume Next With Worksheets(1) For i = 1 To .Cells(Rows.Count, "B").End(xlUp).Row .Cells(i, "B").Copy Worksheets(i + 1).Range("AC2") Next i End With End Sub
Sub Main() Dim i As Long On Error Resume Next With Worksheets(1) For i = 1 To .Cells(Rows.Count, "B").End(xlUp).Row .Cells(i, "B").Copy Worksheets(i + 1).Range("AC2") Next i End With End Sub