Add New Named Worksheets

Sub QuickAddTabs()

''make new worksheets with names stored in the first column of a worksheet

Dim cM As Range
Dim lastRow As Long

On Error GoTo errmsg ''go to error handling if an error occurs

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For Each cM In ActiveSheet.Range("A1:A" & lastRow)
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(ActiveSheet.Name).Name = cM.Value
Next cM

Done:
    Exit Sub

errmsg:
    MsgBox "The Following Error Occurred: " & Err.Description
End Sub