How do you run a macro on all files in a directory?
This is the macro I would like to run on all files in a directory.
Throughout the quarter the macros will have different names and
different functions.
Sub Macro1()
Sheets.Add
ActiveSheet.Name = "copied"
Sheets.Add
ActiveSheet.Name = "copied2"
Sheets.Add
ActiveSheet.Name = "Roster Counts"
Sheets("Staff").Select
Cells.Select
Selection.Copy
Sheets("copied").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A:A,E:E,F:F,G:G").Select
Range("G1").Activate
ActiveWindow.SmallScroll ToRight:=1
Range("A:A,E:E,F:F,G:G,H:H").Select
Range("H1").Activate
Selection.Copy
Sheets("copied2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("copied2").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("A:A").Select
Selection.Copy
Range("C:C,E:E").Select
Range("E1").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
Range("C:C,E:E,G:G").Select
Range("G1").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
Range("F3").Select
Dim lngRow As Long
Dim i As Integer
Dim ColCnt As Integer
ColCnt = Cells(1, 256).End(xlToLeft).Column
lngRow = Range("A65536").End(xlUp).Row
Columns(1).Insert Shift:=xlToRight
With Range(Cells(2, 1), Cells(lngRow, 1))
.FormulaR1C1 = "=R1C[2]"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
For i = 2 To ColCnt / 2
Columns(4).Insert Shift:=xlToRight
Range(Cells(2, 4), Cells(lngRow, 4)).FormulaR1C1 = "=R1C[2]"
Range(Cells(2, 4), Cells(lngRow, 6)).Copy
Range("A65536").End(xlUp)(2).Select
Selection.PasteSpecial xlPasteValues
Range("D:F").Delete
Next i
Range("A1").EntireRow.Delete
Range("A1").Select
Columns("B:B").Select
Selection.NumberFormat = "m/d/yyyy"
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("B1").Select
ActiveCell.FormulaR1C1 = "DATE"
Columns("B:B").Select
Selection.NumberFormat = "m/d/yyyy"
Range("C1").Select
ActiveCell.FormulaR1C1 = "PROGRAMS"
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase, SourceData:= _
"copied2!R1C2:R50000C3").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable5", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,
1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable5").AddFields
RowFields:="PROGRAMS", _
ColumnFields:="DATE"
ActiveSheet.PivotTables("PivotTable5").PivotFields ("DATE").Orientation
= _
xlDataField
ActiveWorkbook.ShowPivotTableFieldList = True
Range("A4").Select
With ActiveSheet.PivotTables("PivotTable5").PivotFields ("PROGRAMS")
.PivotItems("(blank)").Visible = False
End With
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
Cells.Select
Range("A19").Activate
Selection.Copy
Sheets("Roster Counts").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
|