For each loop to create and name worksheets

Try this:

Sub x()

Dim ws As Worksheet, r As Range

With Sheets("Sheet1")
    For Each r In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
        ws.Name = r
        ws.Range("A1") = r
    Next r
End With
        
End Sub