个人macros不在不同的工作簿中循环

我的问题是通过工作簿中的几个工作表循环。

我需要将macros保存在我的个人工作簿中，但是如果我这样做，它将循环通过相同的工作表，直到达到工作表数量。

如果我将代码移动到当前的工作簿，它运作得非常好。 我已经研究了编写macros将个人工作簿中的模块复制到当前工作簿，但是对于其他用户，此模块将简单地保存在仅在后台打开的另一个工作簿中以运行该模块。

如何获取此代码以循环其他工作簿中的所有工作表，代码保存到我的个人工作簿中的模块中，还是保存在另一个在后台打开的工作簿中？

代码如下：

Sub WorksheetLoop() ' Loop Through Worksheets, Add Totals Dim LastRow As Long Dim ws As Worksheet Dim starting_ws As Worksheet Set starting_ws = ActiveSheet ' Loop Sum Formula Through All Worksheets For Each ws In ThisWorkbook.Worksheets ws.Activate 'Now my code, the do something, (I have simplified this part since this _ works, its the loop that's broken) 'Insert new blank rows Rows("1:6").Select Selection.Insert Shift:=xlDown 'Got to next worksheet, but it will not! Next End Sub 

Answer 1

这个代码有一些不同的逻辑，但是如果它有效的话就试一试：

  Sub WorksheetLoop() ' Loop Through Worksheets, Add Totals Dim LastRow As Long Dim ws As Worksheet Dim starting_ws As Worksheet Dim path As String Dim WorkingFile As Workbook ' Select the file you will manipulate to surely be in the correct WB. path = Application.GetOpenFilename(FileFilter:="Excel Files (*.*), *.*", Title:="Please select a file you want to modify") Workbooks.Open path Set WorkingFile = ActiveWorkbook For Each ws In WorkingFile.Worksheets ws.Rows("1:6").Insert Shift:=xlDown 'Rest of the code Next End Sub 

Answer 2

这里是工作代码，现在来比较它最初发布的代码。

再次感谢温尼和戈登！

 Sub Step_3_Add_Subtotals() ' Loop Through Worksheets, Add Totals Dim LastRow As Long Dim ws As Worksheet Dim starting_ws As Worksheet Set starting_ws = ActiveSheet ' Loop Sum Formula Through All Worksheets For Each ws In ActiveWorkbook.Worksheets ws.Activate 'Now my code, the do something 'Insert new blank rows Rows("1:6").Select Selection.Insert Shift:=xlDown 'Copy current headers, paste them in K3:Q3 Range("K7:Q7").Select Selection.Copy Range("K3").Select ActiveSheet.Paste 'Got to next worksheet, and now it does! Next starting_ws.Activate End Sub