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

Question

我将简要介绍一下我的情况：我有6个“主”文件，每个文件包含40个工作表，如下所示：AG工作簿的HR Gp 1至HR Gp 40，ER工作簿的FB Gp 1至Gp 40，等等。所有工作表都是“平”了。我已经设法创建了一个宏（使用Excel Mac 2011），该宏适用于一组（代码在底部），但是我无法使其成功“循环”。感谢您对排序循环的任何帮助非常感谢，迈克Sub Macro3()'' Macro3 Macro'turn off screenWith Application'        .ScreenUpdating = False  only removed while testing'        .EnableEvents = False        '.Calculation = xlCalculationManual  disbled for the momentEnd With'get the path to desktopDim sPath As StringsPath = MacScript("(path to desktop folder as string)")'give a name to new work book for macro useDim NewCaseFile As Workbook'open new workbookSet 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 onApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd 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

最后的建议包括（用工作簿代替Windows ...），下面的更新代码，经过测试且可以使用，非常感谢Mike

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

End Sub