Creating a sorting summary page

Hello,
I am creating a macro for an excel workbook that takes all the data from several worksheets and sorts it alphabetically by name(column 4) on a summary page at the end. Now i am trying to add a column on the summary sheet that indicates which worksheet each row of data came from, before it was mvoed and sorted. here is my current code... the title of each worksheet is also listed in E1 if that helps... and i want it to show up in column 7 in the corresponding rows it belongs with... Thanks so much for any help in advance.

Sub Sort_by_Action_Officer()

MsgBox "Recreation of a summary sheet will permanently delete current summary sheet, to permanently delete press 'ok'"



Application.DisplayAlerts = False

TotalSheets = Worksheets.Count

If Worksheets(Worksheets.Count).Name = "Summary" Then
Worksheets("Summary").Delete
TotalSheets = TotalSheets - 1

End If


Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Summary"
Sheets("Summary").Columns(1).ColumnWidth = 8
Sheets("Summary").Columns(2).ColumnWidth = 14
Sheets("Summary").Columns(3).ColumnWidth = 14
Sheets("Summary").Columns(4).ColumnWidth = 14
Sheets("Summary").Columns(5).ColumnWidth = 60
Sheets("Summary").Columns(6).ColumnWidth = 14
Sheets("summary").Columns(7).ColumnWidth = 20

EndRowCount = 1

For I = 1 To TotalSheets
Sheets(I).Select
StartRow = 4
TotalRows = ActiveSheet.UsedRange.Rows.Count

For Row = StartRow To TotalRows
If Cells(Row, 1) <> "" Then
Sheets(I).Rows(Row).Copy Destination:=Sheets("Summary").Rows(EndRowCount)
Sheets("Summary").Rows(EndRowCount).RowHeight = 50

EndRowCount = EndRowCount + 1


End If
Next Row

Next I



Sheets("Summary").Select



Dim rngSort As Range
Dim rngSortKey As Range

Set rngSort = Range("C1").CurrentRegion

Set rngSortKey = rngSort.Cells(1, 1)
Set rngSortKey = Cells(rngSortKey.Row, rngSortKey.Column _
+ rngSort.Columns.Count - 5)

rngSort.Sort Key1:=rngSortKey, Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'This is where we add the column titles.

Sheets("Summary").Rows(1).Insert
Sheets(1).Rows(3).Copy Destination:=Sheets("Summary").Rows(1)



End Sub