在工作簿中的每個工作表上重復Excel VBA代碼

Question

我有VBA代碼設置，可以刪除行，設置格式列，添加標題等。現在，我需要在工作簿的每個圖紙上重復此代碼。 有些工作簿會有1張紙，有些可能會有幾十張紙。 我看過各種答案，但找不到有效的方法。

這是我需要在每張紙上重復的代碼的片段：

Sub C_FormattingWTitle_Step3_do_on_each_tab()

'Delete all blank empty rows
Dim FirstBlankCell As Long, rngFound As Range
With ActiveSheet
    Set rngFound = .Columns("G:G").Find("*", After:=.Range("G1"), searchdirection:=xlPrevious, LookIn:=xlValues)
    If Not rngFound Is Nothing Then FirstBlankCell = rngFound.Row
End With

If ActiveCell.SpecialCells(xlLastCell) <> rngFound Then
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveWindow.SmallScroll Down:=9
Selection.EntireRow.Delete
Else
Range("A1").Select
End If

'Remove all not 260563 or header in SiteID column
Dim LR As Long, i As Long
    LR = Range("G" & Rows.Count).End(xlUp).Row
    For i = LR To 2 Step -1
    If Not (Range("G" & i).Value Like "260563") And Not (Range("G" & i).Value Like "SiteID") Then Rows(i).Delete
Next i

'Remove all False values and header in Sign in Success column
Dim FR As Long, p As Long
    FR = Range("F" & Rows.Count).End(xlUp).Row
    For p = FR To 2 Step -1
    If Not (Range("F" & p).Value Like True) And Not (Range("F" & p).Value Like "SignInSuccess") Then Rows(p).Delete
Next p

'Remove shading and formatting from header row
Rows("1:1").Select
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

'Format date/time
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy hh:mm:ss;@"

在每個工作表上運行該代碼后，我想插入另存為代碼。 任何幫助將不勝感激。

Answer 1

使用一個單獨的子調用並執行該子例程：

Dim wkst As Worksheet

For Each wkst In ActiveWorkbook.Worksheets
    Call C_FormattingWTitle_Step3_do_on_each_tab(wkst)

Next