Итак, у меня есть 6 «основных» файлов, чтобы затем делить на 40 отдельных файлов

Я кратко опишу, что мне хотелось бы: у меня есть 6 «основных» файлов, каждый из которых содержит 40 рабочих листов: AG рабочая книга имеет HR Gp 1 до HR Gp 40, рабочая книга ER имеет FB Gp от 1 до Gp 40 и т. Д. Все листы " квартира "уже.

Мне удалось создать макрос (используя Excel Mac 2011), который работает для одной группы (код следует внизу), но я не смог сделать его «loop» успешно.

Любая помощь в сортировке цикла будет оценена. Большое спасибо, Майк

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 

Попробуйте что-то вроде этого (пытались придерживаться вашего стиля / подхода)

 '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 

Ну, без мисс Палмер я все равно был бы в темноте (на самом деле был черным черным), но мне удалось заставить его работать (код ниже), но не так изящно, как мне показывали … Еще большое спасибо ей за помощь.

 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 

Последние предложения включены (рабочие книги вместо 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

Давайте будем гением компьютера.