Refactoring an Excel spreadsheet

jukhamil 

Here you go:

Sub CreateSheets()
    Dim wb As Workbook
    Dim w1 As Worksheet
    Dim wn As Worksheet
    Dim m As Long
    Dim n As Long
    Dim c As Long
    Dim nm As String
    Dim rng As Range
    Dim crt As Range
    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    Set w1 = wb.Worksheets(1)
    m = w1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    n = w1.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Set rng = w1.Cells(1, 1).Resize(m, n)
    Set crt = w1.Cells(1, n + 2).Resize(2)
    w1.Cells(2, n + 2).Value = "<>"
    For c = 2 To n
        Set wn = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
        nm = w1.Cells(1, c).Value
        wn.Name = nm
        wn.Cells(1, 1).Value = w1.Cells(1, 1).Value
        wn.Cells(1, 2).Value = nm
        w1.Cells(1, n + 2).Value = nm
        rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=crt, _
            CopyToRange:=wn.Cells(1, 1).Resize(1, 2), Unique:=True
    Next c
    crt.ClearContents
    Application.ScreenUpdating = True
End Sub