Insert many worksheets and name

[Admin]

Hi

Option Explicit

Sub kTest()
    
    Dim NameList, i As Long, msg As String
    
    Application.ScreenUpdating = False
    With ThisWorkbook
        NameList = .Worksheets("Sheet1").Range("a2:a100")   'adjust this list
        On Error Resume Next
        For i = 1 To UBound(NameList, 1)
            If Len(NameList(i, 1)) Then
                .Worksheets.Add().Name = NameList(i, 1)
                If Not Err.Number = 0 Then
                    msg = msg & vbLf & NameList(i, 1)
                    Err.Clear
                End If
            End If
        Next
    End With
    If Len(msg) Then
        MsgBox "The following names are not valid to rename the sheets." & vbLf & msg, vbInformation
    End If
    Application.ScreenUpdating = True
    
End Sub