Create sheet base on the header

Sub CreateHeaderSheets()
Dim lHeaderRow As Long
Dim sMasterSheet As String
Dim iHeaderStartCol As Integer
Dim iHeaderCols As Integer
Dim iHeaderCol As Integer
Dim sHeader As String


    sMasterSheet = "Sheet1"
    lHeaderRow = 1
    iHeaderStartCol = 1
    
    iHeaderCols = Sheets(sMasterSheet).Cells(lHeaderRow, Columns.Count).End(xlUp).Column
    
    For iHeaderCol = iHeaderStartCol To iHeaderCols
    
        sHeader = Sheets(sMasterSheet).Cells(lHeaderRow, iHeaderCol)
            
        If sHeader <> "" Then
                
            On Error Resume Next
            
                Sheets(sHeader).Select
                
            On Error GoTo 0
            
            If ActiveSheet.Name <> sHeader Then
            
                Sheets.Add
                ActiveSheet.Name = sHeader
            
            End If
            
        End If
        
        
    Next iHeaderCol
        
End Sub

Sub fixme()
Dim lMaxRows As Long
Dim iMaxCols As Integer
Dim sHeaderSheet As String
Dim sDataSheet As String
Dim iCol As Integer

    sHeaderSheet = "Data source"
    sDataSheet = "Sheet1"
    
    Sheets(sHeaderSheet).Select
    
    lMaxRows = 0
    
    On Error Resume Next
        lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        iMaxCols = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    On Error GoTo 0
    
    If lMaxRows < 2 Then Exit Sub
    
    With Range(Cells(2, iMaxCols), Cells(lMaxRows, iMaxCols))
        
        .FormulaR1C1 = "=IF(ISERROR(MATCH(RC1, " & sDataSheet & "!R1:R1, 0)), 0,MATCH(RC1, " & sDataSheet & "!R1:R1, 0))"
        .Copy
        .PasteSpecial xlPasteValues
    
    End With
    
    
    If (WorksheetFunction.CountIf(Range(Cells(2, iMaxCols), Cells(lMaxRows, iMaxCols)), "=0") > 0) Then
        Range(Cells(2, iMaxCols), Cells(lMaxRows, iMaxCols)).Clear
        MsgBox ("Please update the data source.")
        Exit Sub
    End If
    
    For iCol = 2 To lMaxRows
    
        Call CopyData(sDataSheet, Cells(lMaxRows, 1), Cells(lMaxRows, iMaxCols))
        
    Next iCol
End Sub


Sub CopyData(sFromSheet As String, CopyHeader As String, CopyCol As Integer, Optional Append As Boolean = True)
Dim sActiveSheet As String
Dim lMaxRows As Long
Dim lMaxDataRows As Long
Dim sCol As String

    sCol = Cells(1, CopyCol).Address(False, False)
    sCol = Left(sCol, Len(sCol) - 1)
    
    sActiveSheet = ActiveSheet.Name
    
    On Error Resume Next
        Sheets(CopyHeader).Select
    On Error GoTo 0
    
    If (ActiveSheet.Name <> CopyHeader) Then
        Sheets.Add
        ActiveSheet.Name = CopyHeader
    End If
    
    
    On Error Resume Next
        lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lMaxDataRows = Sheets(sFromSheet).Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0

    If ((Not Append) Or lMaxRows = 0) Then
        
        Columns(1).Clear
        Sheets(CopyHeader).Range("A:A") = Sheets(sFromSheet).Range(sCol & ":" & sCol).Value
    
    Else
        
        Sheets(sFromSheet).Select
        Range(Cells(2, sCol), Cells(lMaxDataRows, sCol)).Copy
        
        Sheets(CopyHeader).Select
        Cells(lMaxRows + 1, "A").Select
        Selection.PasteSpecial xlPasteValues
        
    End If
    
End Sub