A List From Same Cells Across Multiple Sheets In Excel with sheet names

Question

folks. I have a workbook with multiple sheets, over 200. I'm trying to create in excel a summary sheet called “SUMMARY” where listing the name of all sheets in one column and the content of the cell J2 (in each sheet) in another column. I have found this following code that returns a column with the content of the J2 cell of each sheet but not the columns with the name of the sheet so I'm not able to work with that. Could you give some tips how to implement the code in order to returns both columns?

Sub MakeSummaryTableOfACellAcrossSheets()
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Sheets("SUMMARY").Activate

    For Each ws In Worksheets
        If ws.Name <> "ITEMS FAMILY" Then
            ws.Range("J2").Copy
            ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
        End If
    Next ws

    Application.ScreenUpdating = True

End Sub 

Answer 1

This puts the sheet name in column A of SUMMARY and J2 in column B.

I assumed you also wanted to exclude SUMMARY from your loop.

Transferring values directly rather than copying and pasting is rather quicker.

Use Rows.Count rather than hard-coding 65336 as Excel now has more than a million rows.

Sub MakeSummaryTableOfACellAcrossSheets()

Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In Worksheets
    If ws.Name <> "ITEMS FAMILY" And ws.Name <> "SUMMARY" Then
        Sheets("SUMMARY").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Name
        Sheets("SUMMARY").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("J2").Value
    End If
Next ws

Application.ScreenUpdating = True

End Sub