更新macros以遍历所有工作表并执行

我有一个macros，目前的工作原理是，但我想要使用计数器循环通过每个工作表，执行macros与使用激活命令B / C我的macros引用的ActiveSheet。

我试图改变这几次，但最终的问题，每次不递增到下一张表。 任何帮助，将不胜感激。

Sub Set_Data() Dim lngCount As Long Dim nLastCol, i, j As Integer 'Capture Required Inputs sTerm = InputBox("Enter Term ID") sProduct = InputBox("Enter Product ID") sState = InputBox("Enter 2-Letter State Abbreviation") For j = 1 To ActiveWorkbook.Worksheets.Count Set ws = Worksheets(j) ws.Activate 'DO NOT RUN IF ALREADY RUN If ActiveSheet.Range("A1") <> "Issue Age" Then MsgBox "This Workbook Has Already Been Updated" Exit Sub End If lngCount = Application.WorksheetFunction.CountA(Columns(2)) 'Rename Issue Age Column Header Range("A1").Select ActiveCell.FormulaR1C1 = "Age" 'Insert Term Column Columns("A:A").Insert Shift:=xlToRight Range("A1:A" & lngCount).FormulaR1C1 = sTerm Range("A1").Select ActiveCell.FormulaR1C1 = "termid" 'Insert Product Column Columns("A:A").Insert Shift:=xlToRight Range("A1:A" & lngCount).FormulaR1C1 = sProduct Range("A1").Select ActiveCell.FormulaR1C1 = "productid" 'Insert State Column Columns("A:A").Insert Shift:=xlToRight Range("A1:A" & lngCount).FormulaR1C1 = sState Range("A1").Select ActiveCell.FormulaR1C1 = "State" 'Delete Issue Age Column 'This next variable will get the column number of the very last column that has data in it, so we can use it in a loop later nLastCol = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'This loop will go through each column header and delete the column if the header contains "Issue Age" For i = nLastCol To 1 Step -1 If InStr(1, ActiveSheet.Cells(1, i).Value, "Issue Age", vbTextCompare) > 0 Then ActiveSheet.Columns(i).Delete Shift:=xlShiftToLeft End If Next i 'Delete Empty Column i = ActiveSheet.Cells.SpecialCells(xlLastCell).Column Do Until i = 0 If WorksheetFunction.CountA(Columns(i)) = 0 Then Columns(i).Delete End If i = i - 1 Loop 'Rename Tabs If InStr((ActiveSheet.Name), ("25,000")) Then ActiveSheet.Name = "A25" End If If InStr((ActiveSheet.Name), ("100,000")) Then ActiveSheet.Name = "A100" End If If InStr((ActiveSheet.Name), ("250,000")) Then ActiveSheet.Name = "A250" End If If InStr((ActiveSheet.Name), ("500,000")) Then ActiveSheet.Name = "A500" End If Next j End Sub 

Answer 1

试试看，没有testing过。

 Sub Set_Data() Dim ws As Worksheet Dim lngCount As Long Dim nLastCol, i, j As Integer 'Capture Required Inputs sTerm = InputBox("Enter Term ID") sProduct = InputBox("Enter Product ID") sState = InputBox("Enter 2-Letter State Abbreviation") For Each ws In Worksheets With ws 'DO NOT RUN IF ALREADY RUN If .Range("A1").Value <> "Issue Age" Then MsgBox "This Workbook Has Already Been Updated" Exit Sub End If lngCount = Application.WorksheetFunction.CountA(.Columns(2)) 'Rename Issue Age Column Header .Range("A1").Value = "Age" 'Insert Term Column .Columns("A:A").Insert Shift:=xlToRight .Range("A1:A" & lngCount).Value = sTerm .Range("A1").Value = "termid" 'Insert Product Column .Columns("A:A").Insert Shift:=xlToRight .Range("A1:A" & lngCount).Value = sProduct .Range("A1").Value = "productid" 'Insert State Column .Columns("A:A").Insert Shift:=xlToRight .Range("A1:A" & lngCount).Value = sState .Range("A1").Value = "State" 'Delete Issue Age Column 'This next variable will get the column number of the very last column that has data in it, so we can use it in a loop later nLastCol = .Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'This loop will go through each column header and delete the column if the header contains "Issue Age" For i = nLastCol To 1 Step -1 If InStr(1, .Cells(1, i).Value, "Issue Age", vbTextCompare) > 0 Then .Columns(i).Delete Shift:=xlShiftToLeft End If Next i 'Delete Empty Column i = .Cells.SpecialCells(xlLastCell).Column Do Until i = 0 If WorksheetFunction.CountA(.Columns(i)) = 0 Then .Columns(i).Delete End If i = i - 1 Loop 'Rename Tabs If InStr((.Name), ("25,000")) Then .Name = "A25" End If If InStr((.Name), ("100,000")) Then .Name = "A100" End If If InStr((.Name), ("250,000")) Then .Name = "A250" End If If InStr((.Name), ("500,000")) Then .Name = "A500" End If End With Next ws End Sub 

正如你所说，尽量避免。select， 这可能会帮助你。 如果你想改变一个单元格的内容，而不是插入一个实际的表单使用.Value 。