foo.vb

Option Explicit

Sub CreateMultipleFiles()

   ActiveSheet.Cells.Select
   ActiveSheet.Cells.Replace "Filtered", ""

End Sub

' Format each worksheet
Sub FormatWorksheets()

    Dim sheet As Worksheet
    
    For Each sheet In ActiveWorkbook.Worksheets
        On Error Resume Next
        
        sheet.Visible = xlSheetVisible
        
        ' Select the cells
        sheet.Cells.Select
        sheet.Cells.EntireColumn.Hidden = False
        sheet.Cells.EntireRow.Hidden = False
        sheet.Cells.UnMerge
        sheet.Cells.Ungroup
        
        ' Auto fit rows and columns
        sheet.Rows.AutoFit = True
        sheet.Columns.AutoFit = True
        
        ' Format the page setup stuff
        With sheet.PageSetup
        
            .PrintHeadings = True
            .PrintGridlines = True
            .PrintComments = xlPrintSheetEnd
            .PrintQuality = 300
            .CenterHorizontally = False
            .CenterVertically = False
            .PaperSize = xlPaperEsheet
            .Order = xlOverThenDown
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 25
            .PrintErrors = xlPrintErrorsDisplayed
            .PrintArea = ""
            
            ' Replace FILENAME header, footer
            .LeftHeader = Replace(.LeftHeader, "&F", "")
            .CenterHeader = Replace(.CenterHeader, "&F", "")
            .RightHeader = Replace(.RightHeader, "&F", "")
            
            .LeftFooter = Replace(.LeftFooter, "&F", "")
            .CenterFooter = Replace(.CenterFooter, "&F", "")
            .RightFooter = Replace(.RightFooter, "&F", "")
            
            ' Replace DATE header, footer
            .LeftHeader = Replace(.LeftHeader, "&D", "")
            .CenterHeader = Replace(.CenterHeader, "&D", "")
            .RightHeader = Replace(.RightHeader, "&D", "")
            
            .LeftFooter = Replace(.LeftFooter, "&D", "")
            .CenterFooter = Replace(.CenterFooter, "&D", "")
            .RightFooter = Replace(.RightFooter, "&D", "")
            
            ' Replace PAGENUM header, footer
            .LeftHeader = Replace(.LeftHeader, "&P", "")
            .CenterHeader = Replace(.CenterHeader, "&P", "")
            .RightHeader = Replace(.RightHeader, "&P", "")
            
            .LeftFooter = Replace(.LeftFooter, "&P", "")
            .CenterFooter = Replace(.CenterFooter, "&P", "")
            .RightFooter = Replace(.RightFooter, "&P", "")
            
            ' Replace PATH header, footer
            .LeftHeader = Replace(.LeftHeader, "&Z", "")
            .CenterHeader = Replace(.CenterHeader, "&Z", "")
            .RightHeader = Replace(.RightHeader, "&Z", "")
            
            .LeftFooter = Replace(.LeftFooter, "&Z", "")
            .CenterFooter = Replace(.CenterFooter, "&Z", "")
            .RightFooter = Replace(.RightFooter, "&Z", "")
            
            ' Replace AUTHOR header, footer
            .LeftHeader = Replace(.LeftHeader, "&A", "")
            .CenterHeader = Replace(.CenterHeader, "&A", "")
            .RightHeader = Replace(.RightHeader, "&A", "")
            
            .LeftFooter = Replace(.LeftFooter, "&A", "")
            .CenterFooter = Replace(.CenterFooter, "&A", "")
            .RightFooter = Replace(.RightFooter, "&A", "")
            
            ' Replace TIME header, footer
            .LeftHeader = Replace(.LeftHeader, "&T", "")
            .CenterHeader = Replace(.CenterHeader, "&T", "")
            .RightHeader = Replace(.RightHeader, "&T", "")
            
            .LeftFooter = Replace(.LeftFooter, "&T", "")
            .CenterFooter = Replace(.CenterFooter, "&T", "")
            .RightFooter = Replace(.RightFooter, "&T", "")
            
        End With
        
        ' Locate codes within the file itself
        If sheet.UsedRange.Find("=Today()") Then
            Call sheet.UsedRange.Replace("=Today()", "")
        End If
        
        If sheet.UsedRange.Find("=Now()") Then
            Call sheet.UsedRange.Replace("=Now()", "")
        End If
        
        If sheet.UsedRange.Find("=CELL(""filename"")") Then
            Call sheet.UsedRange.Replace("=CELL(""filename"")", "")
        End If
        
    Next sheet
    
    ActiveWorkbook.Worksheets.Select
    ActiveWorkbook.PrintPreview
    
End Sub

Sub BestVersion()

    Dim rSource As Excel.Range
    Dim rDestination As Excel.Range
    
    Set rSource = ActiveSheet.Cells
    Set rDestination = ActiveSheet.Cells
     
    rSource.Copy
    rDestination.Select
     
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, _
    SkipBlanks:=False, _
    Transpose:=False
     
    Range("A1").Select
     
    Application.CutCopyMode = False
     
valKill:

    Set rSource = Nothing
    Set rDestination = Nothing
     
    Exit Sub
     
End Sub