I have the following code that will filter the data and then create a new file for every unique filtered record. The code works correctly in that it is fllitering and creating the new files. The issue is that it is not pasting the header as well. Also, if there is multiple records for a filter, it is only pasting to the first line of the new file and continuously overwriting the data. Theses are the only two issues that I am noticing with this file. I am wondering if there is code that I could add after wb.Sheets(1).Paste that would solve the issues with this code. Thanks

Sub SplitWorkbook(Optional colLetter As String, Optional SavePath As String)
If colLetter = "" Then colLetter = "D"
Dim lastValue As String
Dim hasHeader As Boolean
Dim wb As Workbook
Dim c As Range
Dim currentRow As Long
hasHeader = True 'Indicate true or false depending on if sheet  has header row.

If SavePath = "" Then SavePath = ThisWorkbook.Path
'Sort the workbook.
ThisWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range(colLetter & ":" & colLetter), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ThisWorkbook.Worksheets(1).Sort
    .SetRange Cells
    If hasHeader Then ' Was a header indicated?
        .Header = xlYes
    Else
        .Header = xlNo
    End If
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

For Each c In ThisWorkbook.Sheets(1).Range("D:D")
    If c.Value = "" Then Exit For
    If c.Row = 1 And hasHeader Then
    Else
        If lastValue <> c.Value Then
            If Not (wb Is Nothing) Then
                wb.SaveAs SavePath & "\" & lastValue & ".xls"
                wb.Close
            End If
            lastValue = c.Value
            currentRow = 1
            Set wb = Application.Workbooks.Add
        End If
        ThisWorkbook.Sheets(1).Rows(c.Row & ":" & c.Row).Copy
        wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Select
       wb.Sheets(1).Paste

    End If
Next
If Not (wb Is Nothing) Then
    wb.SaveAs SavePath & "\" & lastValue & ".xls"
    wb.Close
End If
End Sub