In 5 Seconds Auto Create Multiple Excel Sheets Dynamically

Code: 

 Function mk_progress()

    
    Dim sheet_name, cur_sheet_name, cur_ranage As String
    Dim last_row_num, last_col_num, last_col_letter, last_col_val As String
    Dim new_sheet_last_row As String
    
    'change the name of the sheet to yours
    sheet_name = "Template"
    
   
   'get the last row number with data
    last_row_num = Worksheets(sheet_name).Cells(Rows.Count, 1).End(xlUp).Row
    
    'will get the last column > number
    last_col_num = Worksheets(sheet_name).Cells(1, Columns.Count).End(xlToLeft).Column
    
    'will get the last column > letter
    last_col_letter = Split(Cells(1, last_col_num).Address, "$")(1)
    
    'will get the last column > value
    last_col_val = Worksheets(sheet_name).Cells(1, Columns.Count).End(xlToLeft)
    
    
    Dim tbl As Range
    
    Set tbl = Worksheets(sheet_name).Range("A2", last_col_letter & last_row_num)
    
    For Each Row In tbl.Rows
     
        cur_sheet_name = Row.Cells(1, 1)
        cur_ranage = Row.Address
        
        If (Not WorksheetExists(Row.Cells(1, 1))) Then
            
            'add a new sheet after "template" sheet
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = cur_sheet_name
             
            'insert add header first
            Worksheets(sheet_name).Range("A1", last_col_letter & "1").Copy Worksheets(cur_sheet_name).Range("A1", last_col_letter & "1")
                                  
            'insert second row
            Worksheets(sheet_name).Range(cur_ranage).Copy Worksheets(cur_sheet_name).Range("A2", last_col_letter & "2")
            
            'make the sheet active sheet
            Worksheets(cur_sheet_name).Activate
            
            'select the row that you want to freeze
            Worksheets(cur_sheet_name).Range("A2").Select
            
            'freeze row
            ActiveWindow.FreezePanes = True
            
            'add a filter to first row
            Worksheets(cur_sheet_name).Range("A2").AutoFilter
            
            'make the first row bold
            Worksheets(cur_sheet_name).Range("A1:ZZ1").Font.Bold = True
            
        ElseIf (WorksheetExists(Row.Cells(1, 1))) Then
            
            'old sheet
            
            new_sheet_last_row = Worksheets(cur_sheet_name).Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            'insert add header first
            Worksheets(sheet_name).Range("A1", last_col_letter & "1").Copy Worksheets(cur_sheet_name).Range("A1", last_col_letter & "1")
            
            'add row
            Worksheets(sheet_name).Range(cur_ranage).Copy Worksheets(cur_sheet_name).Range("A" & new_sheet_last_row & ":" & last_col_letter & new_sheet_last_row)
            
            'make the row auto adjust
            Worksheets(cur_sheet_name).Columns.AutoFit
            
        End If
       
    Next Row
    
    'make the template sheet active
    Worksheets(sheet_name).Activate
    
    Dim answer As Integer

    answer = MsgBox("Do you want to clear the old data from template? ", vbQuestion + vbYesNo + vbDefaultButton2, "Confirm Box")
    
    If answer = vbYes Then
        
        'clear old content
        Worksheets(sheet_name).Range("A2:" & last_col_letter & last_row_num).ClearContents
    
        MsgBox "Done"
     
    End If

End Function


Function WorksheetExists(SheetName As String) As Boolean
    
Dim TempSheetName As String

TempSheetName = UCase(SheetName)

WorksheetExists = False
    
For Each Sheet In Worksheets
    If TempSheetName = UCase(Sheet.Name) Then
        WorksheetExists = True
        Exit Function
    End If
Next Sheet

End Function