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 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 ...），下面更新的代码，测试和工作，非常感谢，迈克

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

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

3 个答案: