因此，我有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 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 workbookSet NewCaseFile = Workbooks.Add'-------------------------------------------------Dim strSheetNameAG As StringDim strSheetNameER As String'etcDim intLoop As IntegerFor 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)    'etcNext 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 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'-------------------------------------------------Dim strSheetNameAG As StringDim strSheetNameER As StringDim strSheetNameCS As StringDim strSheetNameEV As StringDim strSheetNameJD As StringDim strSheetNamePG As String'etc'Dim intLoop As IntegerDim i As IntegerFor i = 1 To 40'open new workbookSet 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 FalseNext i'-------------------------------------------------'turn screen back onApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub

Answer 3

最后的建议包括（用工作簿代替Windows ...），下面的更新代码，经过测试且可以使用，非常感谢MikeSub 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 = TrueEnd Sub