harborman1995
New Member
- Joined
- May 22, 2018
- Messages
- 4
Hi all,
I am trying to build an excel macro. This macro will be executed upon the click of a button.
When the macro is activated, it loops through a folder and performs the same operation on each excel file in the folder. The code between 'Start of File Copy Actions' and 'End of file copy actions' is the code which will be executed upon each file. Rather than have the macro identify cells by Cell Address, I am having it identify by the values in the cell.
You can see in the code that a workbook section is being copied from cell "E34" and copies everything to the cell above "
When I run this it is giving me an error saying the Loop at the bottom was created without a "do".
Can someone help me figure this out?
--
Code:
I am trying to build an excel macro. This macro will be executed upon the click of a button.
When the macro is activated, it loops through a folder and performs the same operation on each excel file in the folder. The code between 'Start of File Copy Actions' and 'End of file copy actions' is the code which will be executed upon each file. Rather than have the macro identify cells by Cell Address, I am having it identify by the values in the cell.
You can see in the code that a workbook section is being copied from cell "E34" and copies everything to the cell above "
When I run this it is giving me an error saying the Loop at the bottom was created without a "do".
Can someone help me figure this out?
--
Code:
Code:
Sub Get_Finance()
'PURPOSE: To loop through all Excel files in the project folder and retrieve the necessary financial information
Dim Source_Workbooks 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 the project 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 = "*.xlsm*"
'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 Source_Workbooks = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Opens the Resource Sheet
Sheets("Resource").Select
'START OF FILE COPY ACTIONS
'*****Start of copy/paste section*****
'Sets the Roles / Key Expenses section of OpEx-Build as a variable (And accounts for added rows)
Dim OpExBuild_RKE As Variant
Range("E34").Select
Do Until ActiveCell.Value = "Total Implementation OpEx"
ActiveCell.Range("A1").Offset(1, 0).Select
Loop
ActiveCell.Range("A1").Offset(-1, 0).Select
OpExBuild_RKE = ActiveCell.Address
'Copies the section
Range("E34", OpExBuild_RKE).Copy
'Opens the Analysis Master file
Windows("Analysis_Master.xlsm").Activate
'Opens the Finance Master tab within the Analysis Master file
Sheets("Finance Master").Activate
'Selects the desired paste column of Finance tab
'Checks the Range and selects the first empty row it finds
Range("D3").End(xlUp).Offset(1, 0).Select
'Pastes the copied information into the appropriate column
ActiveSheet.Paste
'Maintains consistent formatting
With Selection.Font
.Name = "Arial"
.Size = 10
'*****End of copy/paste section*****
'END OF FILE COPY ACTIONS
'Save and Close Workbook (needed?)
'Source_Workbook.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Financials Retrieved!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: