Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
302 views
in Technique[技术] by (71.8m points)

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

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
Question&Answers:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...