I am having trouble with my VBA code for my macro that I want to open the msoFileDialogFolderPicker and the user pick a folder in which all the excel files will be opened and one by one data will be copied from the newly open workbook and pasted into specific sheets in the workbook where the macro is running. Basically we give each of our sales rep a spreadsheet to fill out of their sales and then they submit their spreadsheets to the sales manager. What I want to do instead of someone having to open up each spreadsheet and copy the data and paste all of it into one spreadsheet manually, is to simply have a macro that does this for me. Since the location and names of the files can change, I am trying to make it as dynamic as possible. There may be a better way of doing this, so any suggestions are much appreciated!
The issue I am having is that I get the files to open and they copy, but then I get a Run Time Error 1004 'Copy method of Range Class Failed' when I try to get it to paste in the workbook that is running the macro. I have tried ThisWorkbook and ThisWorkbook.Activate to try and tell Excel to go to the spreadsheet where the macro is running, but none solved my problem. Sometimes I get past the error but it still never pastes the data in the master workbook. I have my code written below. Admittedly, it has been mostly copied from code I have found but I have tried to adapt it for my purpose. The line I am getting the error on is the "wb1.Worksheets(1).Range("A5").Select" line.
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim wb1 As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
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
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Set wb1 = ThisWorkbook
Do events
wb.Worksheets(1).Range("A5:H28").Select
Selection.Copy
wb1.Activate
wb1.Worksheets(1).Range("A5").Select
ActiveSheet.Paste
DoEvents
myFile = Dir
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
This is a simplified version of what I am eventually going to do, which includes copying things from multiple worksheets in the newly opened workbook and pasting them in multiple sheets of the originally macro-running workbook. At this point however, I am just trying to get this simple version to run and work. Thank you all for all your help and my apologies for the long code, but I want to give everyone an idea of exactly what I am doing. Thanks!
Stop using Select
and Activate
and writing code that uses Selection
- that's for the macro recorder. You're not a macro recorder, you can write much better code than that.
This is doing too many things and trapping you with late-bound calls working off Object
, which means you're typing code blindly without any help from IntelliSense, no autocompletion, no tooltips:
wb.Worksheets(1).Range("A5:H28").Select
You want a Range
object here.
Dim source As Range
Set source = wb.Worksheets(1).Range("A5:H28")
Now, when you type source.
, IntelliSense can help you. Go on, try:
source.Copy[space]
Notice the tooltip telling you that you can specify a destination right there and then.
So make another range:
Dim destination As Range
Set destination = wb1.Worksheets(1).Range("A5")
And copy away!
source.Copy destination
Now, you should probably call wb.Close
before the end of that loop...