Try this variation:
Dim Master_Sht As Worksheet, Summary_Sht As Worksheet, New_Sht As Worksheet, Third_Sht As Worksheet
Dim rCell_Summary As Range, rCell_ThirdReports As Range
Dim Summary_Last_Row As Long, New_Sht_Next_Row As Long
Dim Total1 As Double
Dim New_Wkbk As Workbook, thisWb As Workbook
Dim theFileName As String, Password As String
Application.ScreenUpdating = False
Set Master_Sht = Sheets("Third Reports")
Set Summary_Sht = Sheets("Summary")
Set Third_Sht = Sheets("Third Reports")
Summary_Last_Row = Summary_Sht.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell_Summary In Summary_Sht.Range("A2:A" & Summary_Last_Row)
Set New_Wkbk = Workbooks.Add
Set New_Sht = New_Wkbk.Sheets(1)
With New_Sht
.Name = rCell_Summary.Value
.Range("A1").Value = "Pers.No."
.Range("B1").Value = "Last name First name"
.Range("C1").Value = "Name of employee or applicant"
.Range("D1").Value = "ID number"
.Range("E1").Value = "Wage Type Long Text"
.Range("F1").Value = "Amount"
.Range("G1").Value = "Crcy"
End With
For Each rCell_ThirdReports In Third_Sht.Range("E2:E100000")
If rCell_ThirdReports.Value = rCell_Summary.Value Then
New_Sht_Next_Row = Application.WorksheetFunction.CountA(New_Sht.Range("A:A")) + 1
New_Sht.Cells(New_Sht_Next_Row, 1).Resize(, 6).Value = Third_Sht.Cells(rCell_ThirdReports.Row, 1).Resize(, 6).Value 'a bit quicker
End If
Next rCell_ThirdReports
With New_Sht
.Cells(New_Sht_Next_Row + 2, 6).Value = Application.WorksheetFunction.Sum(.Range("F:F"))
.Rows(1).Font.Bold = True
.UsedRange.Columns.AutoFit
End With
With New_Wkbk
theFileName = rCell_Summary.Value & " " & Format(Date, "mmmm yyyy")
If Dir(theFileName) <> vbNullString Then Kill theFileName
.SaveAs fileName:=theFileName, Password:="SSC"
.Close savechanges:=False
End With
Next rCell_Summary
Set Master_Sht = Nothing
Set Summary_Sht = Nothing
Set Third_Sht = Nothing
Set New_Sht = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True