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