Macro to list sheet names and last cell value of each sheet

[guybrown]

Hi

Is there a macro that creates a list of all the worksheet names and the value of the last cell from each worksheet?

eg.
RO3 $35,480.00
GE1 $106,425.00

 

[guybrown]

Perhaps a tweak of the following including Ctrl End, copy, paste value beside sheet name?

Sub SheetNames()
Columns(1).Insert
For i = 1 To Sheets.Count
Cells(i, 1) = Sheets(i).Name
Next i
End Sub

 

[Tom Urtis]

You should clarify what "last cell" means to you. Example, if a sheet has 4 columns, and column D's last row is 8, and column B's last row is 12, do you want the value from B12 or D8.

 

[Rick Rothstein]

Let's say you have only two pieces of data, one in D6 and the other in A7... which is the "last cell" to you?

 

[guybrown]

Thanks for responding - appreciated

In answer to your question: Both - I have a tables of different sizes and always want the last cell
eg.
F13 from A1:F13
F17 from A1:F17

The cell that is selected when I hold down Ctrl key and press the End key
The table on each worksheet has a blue line around it and no grid outside of the blue line. Maybe it's a 'print area' or something. When I click Ctrl End it always goes to the cell i want copied...

Hope that helps.

 

[Tom Urtis]

Sub SheetsLastItem()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
Dim strSummary$, iSheet%, LR&, LC&
strSummary = "zzzSummary"
On Error Resume Next
Sheets(strSummary).Delete
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = strSummary
Range("A1:B1").Value = Array("Sheet name", "Last Item")
For iSheet = 1 To Sheets.Count - 1
With Sheets(iSheet)
Cells(iSheet + 1, 1).Value = .Name
If WorksheetFunction.CountA(.Cells) = 0 Then
LR = 1: LC = 1
Else
LR = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LC = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Cells(iSheet + 1, 2).Value = .Cells(LR, LC).Value
End If
End With
Next iSheet
Columns(1).AutoFit: Columns(2).AutoFit
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

 

[guybrown]

Tom

Thank you. Much appreciated!

 

[Rick Rothstein]

This macro outputs your requested list to the ActiveSheet (the ActiveSheet is not reported on)...

Sub ListLastCells()
  Dim WS As Worksheet, OutputRow As Long
  OutputRow = 1
  On Error Resume Next
  For Each WS In Worksheets
    If WS.Name <> ActiveSheet.Name Then
      ActiveSheet.Cells(OutputRow, "A").Value = WS.Name
      ActiveSheet.Cells(OutputRow, "B").Value = WS.Cells(WS.Cells.Find(What:="*", SearchOrder:=xlRows, _
                                                SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
                                                WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                                                SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Address(0, 0)
      If Err.Number Then
        ActiveSheet.Cells(OutputRow, "B").Value = "<<EMPTY Sheet>>"
        Err.Clear
      End If
      OutputRow = OutputRow + 1
    End If
  Next
End Sub