Loop through worksheets take last line add to summary tab

CLCoop

Board Regular
Joined
May 30, 2018
Messages
54
1) Loop through unknown amount of tabs. Take the last row containing data from each worksheet move to the top of each worksheet
2) Look through unknown amount of tabs. Take last row from each tab and input in same order on a summary tab.
Unknown number of tabs as I want to build this to support several different spreadsheets that are done regularly all having anywhere from 2 to 48 tabs with different names.

Basically I'm trying to make a summary sheet of what is in the workbook based.
Right now I have it set up using VBA to build a summary sheet that hyperlinks to each worksheet. But I'm wanting the TOTAL (field name) that could be anywhere in the many different tabs but most always is on the last row to be moved to the top row and to show on the summary page.
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Ron de Bruin

Active Member
Joined
Aug 1, 2006
Messages
271
Platform
  1. Windows
  2. MacOS
Copy macro and function in a module of your test workbook


Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh
Last = LastRow(DestSh)

'Code to copy last row to row 1 after it insert one row
sh.Rows(1).Insert
last2 = LastRow(sh)
sh.Rows(last2).Cut sh.Rows(1)

'Fill in the range that you want to copy in the first row
Set CopyRng = sh.Range("A1:Z1")

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to copy the
'values or want to copy everything look at the example below this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

End If
Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 

Ron de Bruin

Active Member
Joined
Aug 1, 2006
Messages
271
Platform
  1. Windows
  2. MacOS
Change this line to a column after Z in my example below
'Optional: This will copy the sheet name in the H column
DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name
 

Watch MrExcel Video

Forum statistics

Threads
1,127,376
Messages
5,624,334
Members
416,021
Latest member
simbonile

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top