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;）下手动更改它。 。无论如何编写一个自动获取活动工作簿和活动工作表的代码，我每次更改文件名时都必须更改脚本中的名称？
感谢您并感谢任何输入
答案 0 :(得分：0)
如评论中所述，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