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