在工作簿中的每張工作表上重複Excel VBA代碼

我有VBA代碼設置來刪除行，格式列，添加標題等。現在我需要在工作簿中的每張工作表上重複此代碼。有些練習冊會有1張，有些可能有幾十張。我已經看過各種答案，但找不到有效的東西。在工作簿中的每張工作表上重複Excel VBA代碼

下面是代碼片段，我需要有反覆在每張紙上：

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;@"

代碼後，在每片跑，我想插入另存爲代碼。任何幫助將不勝感激。

來源

2017-07-27 LGuelch

可以SO [文件]中找到答案（https://stackoverflow.com/documentation/excel-vba/1144/loop-through - 所有表型活性-工作簿/ 3685 /檢索-全工作表-名稱功能於有源工作簿＃噸= 201707271727205672457） –

使用一個獨立的子調用和執行子程序：

Dim wkst As Worksheet 

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

Next

來源

2017-07-27 17:29:01 Cyril

在工作簿中的每張工作表上重複Excel VBA代碼

回答

相關問題