Следите за рабочими листами

Question

У меня есть около 150 листов, которые я сейчас пытаюсь объединить в один лист. У меня есть следующий код, который я использую

Sub Consolidate() 
Dim sh1 As Worksheet, current As Worksheet, lr As Long, rng As Range, sh As Worksheet 
Set sh1 = Sheets("Sheet1") 
For Each current In Worksheets 
    Set sh = Sheets(current.Name) 
    lr = sh.Cells(Rows.Count, 1).End(xlUp).Row 
    Set rng = sh.Range("A9:A" & lr) 
    rng.EntireRow.Copy sh1.Cells(Rows.Count, 1).End(xlUp)(2) 
Next 
End Sub 

То, что я хочу сделать, это добавить запись в конце каждой строки, чтобы отслеживать, какой файл он пришел с. Эта конкретная информация доступна на каждом листе.

Например

AAA 1 Worksheet1 
BBB 2 Worksheet2 

Любая помощь будет оценена.

Answer 1

Включая @ комментарий Christmas007 в:

Sub Consolidate() 

    Dim sh1 As Worksheet, lr As Long, rng As Range, sh As Worksheet 
    Set sh1 = Sheets("Sheet1") 

    For Each sh In Worksheets 
     If sh.Name <> sh1.Name Then 
     lr = sh.Cells(Rows.Count, 1).End(xlUp).Row 
     Set rng = sh.Range("A9:A" & lr) 
     with sh1.Cells(Rows.Count, 1).End(xlUp).offset(1, 0) 
      .Resize(rng.rows.count,1).Value = sh.Name 
      rng.resize(rng.rows.count, _ 
         rng.EntireRow.columns.count-1).Copy .offset(0,1) 
     End with 

     End If 
    Next 

End Sub 

Answer 2

Option Explicit 

Sub ConsolidateWorkSheets() 
    Dim ws1 As Worksheet, ws As Worksheet, rng As Range 
    Dim sr As Long, lr As Long, lc As Long 

    Set ws1 = Worksheets("Sheet1") 
    For Each ws In Worksheets 
     If ws.Name <> ws1.Name Then 
      lr = ws.UsedRange.Rows.Count + 1 
      Set rng = ws.Range("A9:A" & ws.Cells(lr, 1).End(xlUp).Row) 
      sr = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row + 1 
      rng.EntireRow.Copy ws1.Cells(sr, 1) 
      lr = ws1.Cells(ws1.UsedRange.Rows.Count + 1, 1).End(xlUp).Row 
      lc = ws1.Cells(1, ws1.UsedRange.Columns.Count + 1).End(xlToLeft).Column 
      ws1.Range(ws1.Cells(sr, lc + 1), ws1.Cells(lr, lc + 1)).Value2 = ws.Name 
     End If 
    Next 
End Sub