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
            'select the row that you want to freeze
            'freeze row
            ActiveWindow.FreezePanes = True
            'add a filter to first row
            '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
        End If
    Next Row
    'make the template sheet active
    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