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