为了账号安全,请及时绑定邮箱和手机立即绑定

因此,我有6个“主”文件,然后分成40个单独的文件

因此,我有6个“主”文件,然后分成40个单独的文件

鸿蒙传说 2019-10-04 15:31:48
我将简要描述我想要的内容:我有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 回答

?
偶然的你

TA贡献1841条经验 获得超3个赞

尝试这样的事情(试图坚持自己的风格/方法)


'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


查看完整回答
反对 回复 2019-10-04
?
皈依舞

TA贡献1851条经验 获得超3个赞

好吧,没有帕尔默小姐,我仍然会处于黑暗中(真的是黑色),但设法使其工作(下面的代码),但没有我展示的那么优雅……仍然要感谢她的帮助。


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


查看完整回答
反对 回复 2019-10-04
?
缥缈止盈

TA贡献2041条经验 获得超4个赞

最后的建议包括(用工作簿代替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


查看完整回答
反对 回复 2019-10-04
  • 3 回答
  • 0 关注
  • 364 浏览
慕课专栏
更多

添加回答

举报

0/150
提交
取消
意见反馈 帮助中心 APP下载
官方微信