Question

Sub LoopAllExcelFilesInFolder()

    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
    'SOURCE: www.TheSpreadsheetGuru.com

    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual

    'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

        With FldrPicker
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & "\"
        End With

    'In Case of Cancel
    NextCode:
      myPath = myPath
      If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
      myExtension = "*.xls*"

    'Target Path with Ending Extention
      myFile = Dir(myPath & myExtension)

      'Loop through each Excel file in folder
      Do While myFile <> ""
        'Set variable equal to opened workbook
          Set wb = Workbooks.Open(Filename:=myPath & myFile)

        'Change the file that is open
        Windows(myFile).Activate
        Sheets("T & A").Select                                  'Select the Sheet
        Range("D3").Select                                      'Set the Range
        Selection.Copy                                          'Change the Active File Name
        Windows("Dredger Summary Report.xlsm").Activate
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        'The next active cell will go to the offset
        ActiveCell.Offset(0, 1).Select

        'Next Instruction (Barge Volume)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("T & A").Select
        Range("F130").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 1).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Area)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("Input").Select
        Range("M12").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 1).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Material Type)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("Input").Select
        Range("AE12").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 1).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Depth Before)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("Input").Select
        Range("K12").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 1).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Depth After)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("Input").Select
        Range("J12").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 2).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Dredging Depth)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("Input").Select
        Range("I12").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 1).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Operational Hour)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("T & A").Select
        Range("F86").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 2).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Mechanical Maintenance)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("T & A").Select
        Range("F90").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(0, 1).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>


        'Next Instruction (Shifting Anchor)
        '<<<<<<<<<<<<<Instruction Starts>>>>>>>>>>>>
        'Change the file that is open
        Windows(myFile).Activate
        Sheets("T & A").Select
        Range("F92").Select
        Selection.Copy
        Windows("Dredger Summary Report.xlsm").Activate


        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveCell.Offset(1, -11).Select
        '<<<<<<<<<<<<<<Instruction Ends>>>>>>>>>>>>>



            'Save and Close Workbook
          wb.Close SaveChanges:=False

        'Get next file name
          myFile = Dir

      Loop


    'Message Box when tasks are completed
      MsgBox "Task Complete!"

    ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

End Sub

你好，伙计们，所以我设法完善我的脚本以从不同的工作簿中提取特定数据。但是，在我经过多次询问和谷歌搜索之后，我对代码提出了一个问题。

问题：如果您查看我的代码，每次我将我的活动工作簿（我的目的地）名称更改为其他名称时，我必须在此行Windows（＆＃34; Dredger Summary Report.xlsm＆＃34;）下手动更改它。。无论如何编写一个自动获取活动工作簿和活动工作表的代码，我每次更改文件名时都必须更改脚本中的名称？

感谢您并感谢任何输入

Answer 1

如评论中所述，class Users::RegistrationsController < Devise::RegistrationsController ... ... # POST /resource def create build_resource(sign_up_params) resource.save yield resource if block_given? if resource.persisted? if resource.active_for_authentication? set_flash_message! :notice, :signed_up # Here you need to set your flash message sign_up(resource_name, resource) respond_with resource, location: after_sign_up_path_for(resource) else set_flash_message! :notice, :"signed_up_but_#{resource.inactive_message}" # Here you need to set your flash message expire_data_after_sign_in! respond_with resource, location: after_inactive_sign_up_path_for(resource) end else clean_up_passwords resource set_minimum_password_length respond_with resource end end ... end表示运行宏的文件，因此您可以使用该文件。

同样，您已经将ThisWorkbook作为对循环中打开的每个工作簿的引用，因此您可以使用（例如）：

wb

取代

wb.Activate

但是，您应该避免使用Activate / Select，这样可以使代码更易读/更精简。

而不是单个复制/粘贴：

Windows(myFile).Activate

您可以执行类似

的操作

    Windows(myFile).Activate
    Sheets("T & A").Select   
    Range("D3").Select       
    Selection.Copy           
    Windows("Dredger Summary Report.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                Operation:=xlNone, SkipBlanks:=False,Transpose:=False
    ActiveCell.Offset(0, 1).Select

Excel合并多个工作簿

1 个答案: