Hi,
I want a macro that gets data from columns A:B in a workbook that is located in a folder. I then want that data pasted in the open workbook in which I am working.
The closed workbook is in a folder named "Currency", and the workbook is named, "StudyCurrency_Source". The data is on the first sheet in columns A:B. The path is:
C:\Users\RuanoC\Desktop\Temp\Matthew\Currency
I want columns A:B pasted into a sheet named "Currency" in the open workbook (it is the first worksheet in this workbook).
I provided the path to the source workbook; however, I would prefer to use the Folder Picker method if possible.
So as not to ask for help without providing anything with my request, please look at the macro below. It uses the folder picker method. I hope that somebody might be able to modify part of it to do what I am looking to achieve. I am a vba dummy, but I have attempted to separate the section of the code that I think needs to be modified with several comment marks above and below.
Sub GetCurrencies()
'PURPOSE: Get study currencies from Currency folder
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim LR As Long
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Dim Path As String
'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)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'
'
'
'
'
'
'Code to Combine sheets of multiple workbooks
For Each Sheet In wb.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
wb.Close False
'
'
'
'
'
'
'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 "Study currencies loaded"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ActiveWorkbook.CheckCompatibility = True
End Sub
All help is much appreciated!
Carlos
Bookmarks