所以，我有6个“主”文件，然后分成40个单独的文件

我将简要介绍一下我想要的：我有6个“主”文件，每个文件包含40个工作表：AG工作簿有HR Gp 1到HR Gp 40，ER工作簿有FB Gp 1到Gp 40等。平“已经。

我设法创build了一个适用于一个组的macros（使用Excel Mac 2011）（代码如下），但是我还没有成功完成“循环”。

任何帮助sorting循环，将不胜感激非常感谢，迈克

Sub Macro3() ' ' Macro3 Macro 'turn off screen With Application ' .ScreenUpdating = False only removed while testing ' .EnableEvents = False '.Calculation = xlCalculationManual disbled for the moment End With 'get the path to desktop Dim sPath As String sPath = MacScript("(path to desktop folder as string)") 'give a name to new work book for macro use Dim NewCaseFile As Workbook 'open new workbook Set NewCaseFile = Workbooks.Add 'Move group 1's sheets to NewcaseFile : 1 sheet from 6 workbooks... Windows("AG.xlsx").Activate Sheets("HR gp 1").Select Sheets("HR gp 1").Move Before:=NewCaseFile.Sheets(1) Windows("ER.xlsx").Activate Sheets("F&B gp 1").Select Sheets("F&B gp 1").Move Before:=NewCaseFile.Sheets(1) Windows("CS.xlsx").Activate Sheets("Acc gp 1").Select Sheets("Acc gp 1").Move Before:=NewCaseFile.Sheets(1) Windows("EV.xlsx").Activate Sheets("Mkt gp 1").Select Sheets("Mkt gp 1").Move Before:=NewCaseFile.Sheets(1) Windows("JD.xlsx").Activate Sheets("Rdiv gp 1").Select Sheets("Rdiv gp 1").Move Before:=NewCaseFile.Sheets(1) Windows("PG.xlsx").Activate Sheets("Fac gp 1").Select Sheets("Fac gp 1").Move Before:=NewCaseFile.Sheets(1) 'Save the created file for Group1 ActiveWorkbook.SaveAs Filename:=sPath & "gp 1.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close False 'turn screen back on Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

Answer 1

尝试像这样（试图坚持你的风格/方法）

 'open new workbook Set NewCaseFile = Workbooks.Add '------------------------------------------------- Dim strSheetNameAG As String Dim strSheetNameER As String 'etc Dim intLoop As Integer For intLoop = 1 To 40 'set sheet names strSheetNameAG = "HR gp " & i strSheetNameER = "F&B gp " & i 'etc 'move them across Windows("AG.xlsx").Sheets(strSheetNameAG).Move Before:=NewCaseFile.Sheets(1) Windows("ER.xlsx").Sheets(strSheetNameAG).Move Before:=NewCaseFile.Sheets(1) 'etc Next intLoop '------------------------------------------------- 'Save the created file for Group1 ActiveWorkbook.SaveAs Filename:=sPath & "gp 1.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close False 

Answer 2

那么，如果没有帕尔默小姐，我仍然会在黑暗中（真正的黑色），但设法使其工作（代码如下），但没有像我所显示的那样优雅…还是非常感谢她的帮助。

 Sub Macro4() 'turn off screen With Application ' .ScreenUpdating = False only removed while testing ' .EnableEvents = False '.Calculation = xlCalculationManual disbled for the moment End With 'get the path to desktop Dim sPath As String sPath = MacScript("(path to desktop folder as string)") 'give a name to new work book for macro use Dim NewCaseFile As Workbook '------------------------------------------------- Dim strSheetNameAG As String Dim strSheetNameER As String Dim strSheetNameCS As String Dim strSheetNameEV As String Dim strSheetNameJD As String Dim strSheetNamePG As String 'etc 'Dim intLoop As Integer Dim i As Integer For i = 1 To 40 'open new workbook Set NewCaseFile = Workbooks.Add 'set sheet names strSheetNameAG = "HR gp " & i strSheetNameER = "F&B gp " & i strSheetNameCS = "Acc gp " & i strSheetNameEV = "Mkt gp " & i strSheetNameJD = "Rdiv gp " & i strSheetNamePG = "Fac gp " & i 'etc 'move them across Windows("AG.xlsx").Activate Sheets(strSheetNameAG).Select Sheets(strSheetNameAG).Move Before:=NewCaseFile.Sheets(1) Windows("ER.xlsx").Activate Sheets(strSheetNameER).Select Sheets(strSheetNameER).Move Before:=NewCaseFile.Sheets(1) Windows("CS.xlsx").Activate Sheets(strSheetNameCS).Select Sheets(strSheetNameCS).Move Before:=NewCaseFile.Sheets(1) Windows("EV.xlsx").Activate Sheets(strSheetNameEV).Select Sheets(strSheetNameEV).Move Before:=NewCaseFile.Sheets(1) Windows("JD.xlsx").Activate Sheets(strSheetNameJD).Select Sheets(strSheetNameJD).Move Before:=NewCaseFile.Sheets(1) Windows("PG.xlsx").Activate Sheets(strSheetNamePG).Select Sheets(strSheetNamePG).Move Before:=NewCaseFile.Sheets(1) 'etc 'Save the created file for Group in use ActiveWorkbook.SaveAs Filename:=sPath & "gp " & i & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close False Next i '------------------------------------------------- 'turn screen back on Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

Answer 3

包括最后的build议（工作簿，而不是Windows …），更新后的代码，testing和工作，非常感谢，迈克

 Sub Macro4() 'turn off screen With Application ' .ScreenUpdating = False only removed while testing ' .EnableEvents = False '.Calculation = xlCalculationManual disbled for the moment End With 'get the path to desktop Dim sPath As String sPath = MacScript("(path to desktop folder as string)") 'give a name to new work book for macro use Dim NewCaseFile As Workbook 'Create sheet names Dim strSheetNameAG As String Dim strSheetNameER As String Dim strSheetNameCS As String Dim strSheetNameEV As String Dim strSheetNameJD As String Dim strSheetNamePG As String 'Create loop counter variable 'Dim intLoop As Integer Dim i As Integer For i = 1 To 40 'open new workbook Set NewCaseFile = Workbooks.Add 'set sheet names strSheetNameAG = "HR gp " & i strSheetNameER = "F&B gp " & i strSheetNameCS = "Acc gp " & i strSheetNameEV = "Mkt gp " & i strSheetNameJD = "Rdiv gp " & i strSheetNamePG = "Fac gp " & i 'move them across Workbooks("AG.xlsx").Sheets(strSheetNameAG).Move Before:=NewCaseFile.Sheets(1) Workbooks("ER.xlsx").Sheets(strSheetNameER).Move Before:=NewCaseFile.Sheets(1) Workbooks("CS.xlsx").Sheets(strSheetNameCS).Move Before:=NewCaseFile.Sheets(1) Workbooks("EV.xlsx").Sheets(strSheetNameEV).Move Before:=NewCaseFile.Sheets(1) Workbooks("JD.xlsx").Sheets(strSheetNameJD).Move Before:=NewCaseFile.Sheets(1) Workbooks("PG.xlsx").Sheets(strSheetNamePG).Move Before:=NewCaseFile.Sheets(1) 'Save the created file for Group in use ActiveWorkbook.SaveAs Filename:=sPath & "gp " & i & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close False Next i '------------------------------------------------- 'turn screen back on Application.ScreenUpdating = True Application.DisplayAlerts = True 

结束小组