Уважаемые форумчане , подскажите пожалуйста , как в этом макросе указать адрес (название каждого листа и книги) перед каждым на листе ("полный список") ?


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

Перед, каждыми собранными данными с одного листа в начале на строку выше, что-бы было написано название с какого листа эти данные к примеру (Лист 1 и т.д ) , на общем листе .

Саша2410,

Если кому будет интересно вот , код . IgorGO помог !!!

Sub superkorobka()
Dim Ws As Worksheet
Dim LastRow As Long
Dim iLastRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Sheets(Sheets.Count).Name = "Полный_список" Then
Sheets(Sheets.Count).Activate
Else
Sheets(1).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Полный_список"
End If
ActiveSheet.UsedRange.Clear
For i = 1 To Sheets.Count - 1
LastRow = Cells(Rows.Count, 2).End(xlUp).row + 1
Cells(LastRow, 1) = Sheets(i).Name
LastRow = LastRow + 1
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