Напечатайте название листа вместе с скопированной ячейкой

Question

У меня есть этот код, где он перебирает все листы в рабочей книге, копирует значение в F9 каждого листа и вставляет его в столбец «Сводка» листа A. Как я могу также напечатать имя листа в столбце B? Таким образом, значение находится рядом с именем листа на листе «Сводка».

код:

Sub loopsheet()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
   If Not wks.Name = "Summary" Then
   wks.Range("F9:F" & wks.Cells(Rows.Count, "F").End(xlUp).Row).Copy _
   Destination:=Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)

   End If
   Next
End Sub

Спасибо

Answer 1

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

Я считаю, cLR + pLR - 11 - это размер диапазона.Смещение связано с заголовками, смещением LR и тем фактом, что вы начинаете копирование с 9-й строки.После того, как вы запустите это, вам, возможно, придется изменить его вверх или вниз, если я ошибаюсь.

Option Explicit

Sub LoopSheet()

Dim ws As Worksheet
Dim Summary As Worksheet: Set Summary = ThisWorkbook.Sheets("Summary")
Dim cLR As Long, pLR As Long

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> Summary.Name Then
        cLR = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
        pLR = Summary.Range("A" & Summary.Rows.Count).End(xlUp).Offset(1).Row

        ws.Range("F9:F" & cLR).Copy Summary.Range("A" & pLR)
        Summary.Range(Summary.Cells(pLR, 2), Summary.Cells(cLR + pLR - 11, 2)).Value = ws.Name
    End If
Next ws

End Sub