Как в этом макросе указать название каждого листа и книги ,при сборе всех листов на один ? - VB

Формулировка задачи:

Уважаемые , подскажите пожалуйста , как в этом макросе указать адрес (название каждого листа и книги) перед каждым на листе ("полный список") ?
Sub korobka()
Dim Ws As Worksheet
Dim LastRow As Long
Dim iLastRow As Long
Dim Rng As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Sheets(Sheets.Count).Name = "Полный_список" Then Sheets(Sheets.Count).Delete
Sheets(1).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Полный_список"
Set Rng = ActiveSheet.UsedRange
Rng.Clear
For i = 1 To Sheets.Count - 1
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
With Sheets(i)
iLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(1, 1), .Cells(iLastRow, 3)).Copy Cells(LastRow + 2, 1)
Range(.Cells(1, 6), .Cells(iLastRow, 9)).Copy Cells(LastRow + 2, 5)
End With
Next
Rows(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Решение задачи: «Как в этом макросе указать название каждого листа и книги ,при сборе всех листов на один ?»

textual
                            Листинг программы 
                        

                            <font color="blue">Sub</font> korobka()
<font color="blue">Dim</font> Ws <font color="blue">As</font> Worksheet
<font color="blue">Dim</font> LastRow <font color="blue">As</font> <font color="blue">Long</font>
<font color="blue">Dim</font> iLastRow <font color="blue">As</font> <font color="blue">Long</font>
<font color="blue">Dim</font> Rng <font color="blue">As</font> Range
<font color="blue">Dim</font> sWorkBook <font color="blue">as</font> <font color="blue">String</font>
Application.DisplayAlerts = False
Application.ScreenUpdating = False
<font color="blue">If</font> Sheets(Sheets.Count).<font color="blue">Name</font> = <font color="teal">"Полный_список"</font> <font color="blue">Then</font> Sheets(Sheets.Count).Delete
Sheets(<font color="darkblue"><b>1</b></font>).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).<font color="blue">Name</font> = <font color="teal">"Полный_список"</font>
<font color="blue">Set</font> Rng = ActiveSheet.UsedRange
Rng.Clear
sWorkBook = <font color="teal">"Книга: "</font> & ThisWorkbook.<font color="blue">Name</font>
<font color="blue">For</font> i = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> Sheets.Count - <font color="darkblue"><b>1</b></font>
LastRow = Cells(Rows.Count, <font color="darkblue"><b>2</b></font>).<font color="blue">End</font>(xlUp).Row
<font color="blue">With</font> Sheets(i)
iLastRow = .Cells(Rows.Count, <font color="darkblue"><b>2</b></font>).<font color="blue">End</font>(xlUp).Row
Range(.Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), .Cells(iLastRow, <font color="darkblue"><b>3</b></font>)).Copy Cells(LastRow + <font color="darkblue"><b>2</b></font>, <font color="darkblue"><b>1</b></font>)
Range(.Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>6</b></font>), .Cells(iLastRow, <font color="darkblue"><b>9</b></font>)).Copy Cells(LastRow + <font color="darkblue"><b>2</b></font>, <font color="darkblue"><b>5</b></font>)
Cells(LastRow + <font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>).Value = sWorkBook & <font color="teal">"; Лист: "</font> & .<font color="blue">Name</font>
<font color="blue">End</font> <font color="blue">With</font>
<font color="blue">Next</font>
Rows(<font color="darkblue"><b>1</b></font>).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
<font color="blue">End</font> <font color="blue">Sub</font>

                        