So, I have 6 "master" files to then divide into 40 separate files

Question

I will briefly describe what I would like: I have 6 "master" files each containing 40 worksheets as follows: AG workbook has HR Gp 1 to HR Gp 40, ER workbook has FB Gp 1 to Gp 40, etc. All sheets are "flat" already.

I have managed to create a macro (using Excel Mac 2011) which works for one group (code follows at the bottom), but I have not been able to make it "loop" successfully.

Any help to sort the loop would be appreciated Many thanks, Mike

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

score 4 · Accepted Answer · answered Jun 01 '15 at 15:46

4

Try something like this (tried to stick to your style/approach)

'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

answered Jun 01 '15 at 15:46

tea_pea

1,482
14
19

So, perhaps my approach not the best, but you have shown me a neater solution. I will move the save and use the "i" to build the filename as that needs to be incremented as well. Much appreciated! Will post the update. – Solar Mike Jun 01 '15 at 17:14
So, got daughter to bed!!, but macro stops with error at the point .Sheets - "Method or data member not found, have tried putting quotes around strSheetNameAG with no result. Any help please. – Solar Mike Jun 01 '15 at 21:21
some success this eve then! i forgot to change second strSheetNameAG to strSheetNameER... that might be it? – tea_pea Jun 01 '15 at 21:48
I followed that, it was the .Sheet being ignored for why I don't know, changed to the longer statements (even though another programmer says not to use Select...) and it now works, so thanks very very much as it was hard to move 240 sheets by hand! Posted solution so people can benefit and perhaps make a more concise solution if necessary.ttfn Mike – Solar Mike Jun 01 '15 at 22:01
Ah, I see it's because we were using 'Windows' (which I was unfamiliar with) rather than 'Workbooks'. The following should work Workbooks("AG.xlsx").Sheets(strSheetNameAG).Move Before:=NewCaseFile.Sheets(1) – tea_pea Jun 02 '15 at 09:35
glad to help anyway. please remember to vote/select my answer when you have enough rep to do so! :) – tea_pea Jun 02 '15 at 09:35

score 3 · Answer 2 · answered Jun 01 '15 at 21:58

Well, without Miss Palmer I would still be in the dark (jet black really) but managed to make it work (code below) but not as elegant as I was shown... Still many thanks to her help.

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

score 1 · Answer 3 · edited Jul 30 '18 at 21:24

Last suggestions included (Workbooks instead of Windows...), updated code below, tested and works, many thanks, 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

So, I have 6 "master" files to then divide into 40 separate files

3 Answers3

Linked