Running a Macro on a set number of tabs

[maxw7]

Hello,

This is my first post and I'm somewhat new to Macros. I'm currently working on fixing a Macro for my manager and it is currently fixed and doing what we want but there is one "cosmetic" that we would like to fix. Currently the macro is looking at a template to get column headers and then it looks at all the previous tabs in the workbook to pull our data. Would it be possible to limit the Macro to instead of pulling data from all the tabs to instead look at and pull the data from the 60 most recent tabs? Thanks in advance!

Dim Sh As Worksheet
    Dim Newsh As Worksheet
    Dim myCell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim Basebook As Workbook
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    'Delete the sheet "Summary-Sheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("Summary-Sheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Add a worksheet with the name "Summary-Sheet"
    Set Basebook = ThisWorkbook
    Set Newsh = Basebook.Worksheets.Add
    Newsh.Name = "Summary-Sheet"
    'The links to the first sheet will start in row 2
    RwNum = 1
    For Each Sh In Basebook.Worksheets
        If Sh.Name <> Newsh.Name And Sh.Visible Then
            ColNum = 1
            RwNum = RwNum + 1
            'Copy the sheet name in the A column
            Newsh.Cells(RwNum, 1).Value = Sh.Name
            For Each myCell In Sh.Range("C3:C13")  '<--Change the range
                ColNum = ColNum + 1
                Newsh.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell
        End If
    Next Sh
    Newsh.UsedRange.Columns.AutoFit
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
    ' Paste Values over worksheet references so that you can reverse order
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    
    'delete the non-data rows at the top
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
    ' NumberRows Macro
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Set nos = Range("B1", Range("B1").End(xlDown)).Offset(0, -1)
    nos.Resize(1, 1).Value = 1
    nos.Resize(1, 1).AutoFill nos, xlFillSeries
    nos.NumberFormat = "General""."""
    
    ' Reverses the order of  populated rows
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Worksheets("Summary-Sheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Summary-Sheet").Sort.SortFields.Add Key:= _
        ActiveCell.Range("A1:A5000"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Summary-Sheet").Sort
        .SetRange ActiveCell.Range("A1:M5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    ActiveCell.SpecialCells(xlLastCell).Select
    
    'Format the output
    
    Columns("B:M").Select
    Selection.Style = "Comma"
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Template").Select
    Range("A3:A13").Select
    Selection.Copy
    Sheets("Summary-Sheet").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Selection.Font.Bold = True
    Columns("A:M").Select
    Columns("A:M").EntireColumn.AutoFit
    ActiveCell.SpecialCells(xlLastCell).Select
    
    'Delete unwanted data
    'If new institutions are added - adjust the columns to be deleted.
    
    Columns("I:K").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    
    'Add column and format date
    Columns("B:B").Select
    Selection.Insert
    Range("A2").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEN(RC[-1])=5,DATE(2000+RIGHT(RC[-1],2),LEFT(RC[-1],1),RIGHT(LEFT(RC[-1],3),2)),DATE(2000+RIGHT(RC[-1],2),LEFT(RC[-1],2),RIGHT(LEFT(RC[-1],4),2)))"
    Range("B2").Select
    Selection.NumberFormat = "m/d/yyyy;@"
    Selection.AutoFill Destination:=Range("B2:B" & Range("D" & Rows.Count).End(xlUp).Row)
    Columns("B:B").EntireColumn.AutoFit
    Range("A2").Select
    ActiveCell.SpecialCells(xlLastCell).Select

End Sub

 

[Michael M]

Don't have Excel at the moment, but how many tabs are there in total ??
How do you determine what are the most recent 60 tabs ?

 

[maxw7]

I’m not at my computer right now but I want to say it is about 1100 tabs. I would want it to pick the sixty tabs furthest left on the toolbar would be what I would consider the most recent.

 

[Michael M]

Maybe like this...

Sub MM1()
Dim n As Integer
For n = 1 To 60
    Sheets(n).Select
    'your code here
Next n
End Sub

 

[maxw7]

Maybe like this...

Sub MM1()
Dim n As Integer
For n = 1 To 60
    Sheets(n).Select
    'your code here
Next n
End Sub

Thanks Michael, I will give it a try when I get to work tomorrow!

 

[maxw7]

Maybe like this...

Sub MM1()
Dim n As Integer
For n = 1 To 60
    Sheets(n).Select
    'your code here
Next n
End Sub

It looks like this didn't work. It ended up just putting the summary sheet that is created as the 60th tab.

 

[Michael M]

If you step through the code using F8, does it select each sheet ??

 

[maxw7]

If you step through the code using F8, does it select each sheet ??

This will show how much of a newbie I am at VBA as I had never known that you could step through the code using F8. Using this I was able to find the section of code that is looking at the tabs and I believe that my manager who created the code had mentioned that it will just keep looking at the tabs until it hits the last tab. That section of will be in the next comment.

 

[maxw7]

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 1
RwNum = RwNum + 1
'Copy the sheet name in the A column
Newsh.Cells(RwNum, 1).Value = Sh.Name
For Each myCell In Sh.Range("C3:C13") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
End If

 

[Michael M]

OK, but post #8 didn't really answer my question.
By using F8 does the code .Select each sheet progressively ??