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!
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!
Code:
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
Last edited by a moderator:
