0

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
  • 1
    You should start by reading Debugging VBA Code • My Online Training Hub and learn how to debug your own code ... – DavidPostill Jan 29 at 18:45
  • I don't think your if statement you mention is the main cause. I don't see where you are renaming the destination file so that you get different files on saving... – gns100 Jan 29 at 18:49
  • Side note: in general, it's a good idea to avoid select in your code – cybernetic.nomad Jan 29 at 19:29
  • @gns100, it's not intended to create different files, it copies from a load of separate files and pastes them into the single Destination file which remains open while the macro runs. – David H Jan 30 at 8:16
  • @DavidPostill I've already tried that and not found the problem, otherwise I wouldn't have posted here - how is it helpful to comment that? When stepping through it automatically executes the loop, and I've tried using the same instructions in a series of separate steps and it works. – David H Jan 30 at 8:58
0

So it turns out that the check:

If IsEmpty(Range("A4").Value) = True

Was checking cell A4 in the file where the macro was saved, not in the Destination file as I had hoped it would by including this:

Workbooks("Destination.xlsm").Sheets("Destination").Activate
ActiveSheet.Range("A3").Select

Having changed the check to:

If IsEmpty (Workbooks("Destination.xlsm").Sheets("Destination").Range("A4").Value) = True

It now works as intended.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.