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