我將簡要介紹一下我的情況：我有6個“主”文件，每個文件包含40個工作表，如下所示：AG工作簿的HR Gp 1至HR Gp 40，ER工作簿的FB Gp 1至Gp 40，等等。所有工作表都是“平”了。我已經設法創建了一個宏（使用Excel Mac 2011），該宏適用于一組（代碼在底部），但是我無法使其成功“循環”。感謝您對排序循環的任何幫助非常感謝，邁克Sub Macro3()'' Macro3 Macro'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'open new workbookSet 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 onApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
3 回答
holdtom
TA貢獻1805條經驗 獲得超10個贊
嘗試這樣的事情（試圖堅持自己的風格/方法）
'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
守著星空守著你
TA貢獻1799條經驗 獲得超8個贊
好吧，沒有帕爾默小姐，我仍然會處于黑暗中（真的是黑色），但設法使其工作（下面的代碼），但沒有我展示的那么優雅……仍然要感謝她的幫助。
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
陪伴而非守候
TA貢獻1757條經驗 獲得超8個贊
最后的建議包括（用工作簿代替Windows ...），下面的更新代碼，經過測試且可以使用，非常感謝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
- 3 回答
- 0 關注
- 451 瀏覽
相關問題推薦
添加回答
舉報
0/150
提交
取消