I have a question regarding a macro that's not performing in the way expected. I took a script I found online to cycle through a number of files in the same directory and perform the same action on each, and have tested it on various simple actions (e.g. delete top 2 rows, colour a certain column blue, etc).
However, I now want to do something slightly more complex with it, which is cycle through the files, select an area, and copy & paste it into another file (Destination.xlsm). The column header for the first column is in A3, so my idea was to select A3, ctrl&down to get to the end of the data already there, then go 1 cell down by using Offset, then paste the next file. I realised this caused an error when the paste area was empty, as it would go into the last possible cell and then try to go 1 down from that, which is impossible. This is when I added the If statement, so if A4 is empty it goes 1 cell down from A3 and pastes. If A4 is not empty it means some data has already been pasted, so it will go to the end of this, then 1 cell down, then paste.
The problem is that it pastes each successive file over the last one, leaving me with only the last file's contents once the loop has completed. As far as I can tell the If statement should stop it from doing this, and I can't think of what else could be wrong with the process. Any help would be greatly appreciated!
The code is as follows:
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and
perform a set task on them
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
Application.DisplayAlerts = False
'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
'Perform action to be repeated (paste into external file)
wb.Worksheets(1).Range("A2:N2").Select
wb.Worksheets(1).Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks("Destination.xlsm").Sheets("Destination").Activate
ActiveSheet.Range("A3").Select
If IsEmpty(Range("A4").Value) = True Then
ActiveCell.Offset(1, 0).Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb.Worksheets(1).Activate
'Save and Close Workbook
wb.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 "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub
