xcelnovice101
Active Member
- Joined
- Aug 24, 2012
- Messages
- 368
Below is my code for the first tab and as you can tell, I'm cheating by using "Sheets(1)". Rather than having to rename each variable and sheet as "Sheets(2)"....., is there a simple of of having excel loop the exact same code provided below for each sheet in the active workbook? If it is possible, I realize I'll need to adjust part of this code that calls out Sheets(1).
Code:
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
' Insert Date
Sheets(1).Select
Columns("C:C").EntireColumn.AutoFit
Dim SEAD As Long
SEAD = Range("C" & Cells.Rows.Count).End(xlUp).Row
Range(Range("D12"), Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
Dim LEND As Long
LEND = Range("C" & Cells.Rows.Count).End(xlUp).Row
Range(Range("E12"), Range("E" & LEND)).Formula = "=LEN(RC[-2])"
Dim RGTD As Long
RGTD = Range("C" & Cells.Rows.Count).End(xlUp).Row
Range(Range("F12"), Range("F" & RGTD)).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
Dim VLUD As Long
VLUD = Range("C" & Cells.Rows.Count).End(xlUp).Row
Range(Range("B12"), Range("B" & VLUD)).Formula = "=VALUE(RC[4])"
Range(Range("B12"), Range("B" & VLUD)).Copy
Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("D12").End(xlDown).ClearContents
Range("B12").Select
Range(Selection, Selection.End(xlDown)).ClearContents
Range("E12:F12").Select
Range(Selection, Selection.End(xlDown)).ClearContents
Columns("D:D").EntireColumn.AutoFit
Columns("D:D").NumberFormat = "m/d/yyyy"
Columns("F:F").Delete Shift:=xlToLeft
Range("F12").Select
'Rename Sheets & Save Files
Dim Port1, Month, Year1, NM As String
Port1 = Left(Sheets(1).[A2], 4)
Year1 = Year([D12])
Month = Format(Sheets(1).[D12], "MMMM")
Sheets(1).Name = Port1
NM = Month & " MTD FS Returns.xlsm"
Sheets(1).Select
Sheets(1).Copy
ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.ScreenUpdating = True
End Sub