locked
Copying Filtered Data from multiple workbooks into a Summary Workbook RRS feed

  • Question

  • Hello. I'm attempting my first macro and running into a problem I can't resolve. The below macro filters the data and saves the workbooks correctly but when I open the summary workbook it is still empty.

    MS Excel 2010

    The first event (which does work) asks excel to loop through each file in a selected folder, filter the data for specified criteria, save and close the workbook.

    the second event (which does not work) asks to open each file in the same selected folder, copy the filtered data, close the open workbook, open the summary workbook, paste the data in the next available row, close the summary workbook and do the same to the rest of the files in the selected folder.

    On every file there are the same headers in row1, column A to T

    any assistance would be greatly appreciated

    
    Sub AdminDenAuthProjConsolidate()
    '
    ' AdminDenAuthProjConsolidate Macro
    '
    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim FolderPath As String, Filepath As String, Filename As String
    Dim masterFolderPath As String, masterFilePath As String, masterFileName 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
          
        'Filter worksheet for Denial - Administrative
        Selection.AutoFilter
        wb.Worksheets(1).Range("A1:T" & Range("T" & Rows.Count).End(xlUp).Row).AutoFilter Field:=11, Criteria1:= _
            "Denial - Administrative"
    
        '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
      
    'Copy relevant data from all workbooks
    '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
    
    'Copy Data Range
        Range("A2:T" & Range("T" & Rows.Count).End(xlUp).Row).Select
        Selection.Copy
        
    'Save and Close Workbook
        Application.DisplayAlerts = False
        wb.Close SaveChanges:=True
        
    'Ensure Workbook has closed before moving on to next line of code
        DoEvents
    
    'Paste data into summary workbook
    'Open Master Summary Workbook
    'and paste data beginning at first empty row
        masterFolderPath = "C:\Users\A087711\Desktop\Admin Denial Auth Project\"
        masterFilePath = masterFolderPath & "AdminDenialSummary.xlsx"
        masterFileName = Dir(masterFilePath)
    
        Dim lastrow As Long, lastcolumn As Long
        Workbooks.Open (masterFolderPath & masterFileName)
        erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste
        ActiveWorkbook.Close
        
    'Ensure Workbook has closed before moving on to next line of code
        DoEvents
        
    'Get next file name
        myFile = Dir
          
      Loop
      
    Application.DisplayAlerts = True
    
    'Message Box when tasks are completed
      MsgBox "Task Complete!"
    
    ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    
    End Sub
    
    
    

    Monday, August 22, 2016 7:24 PM

All replies

  • ActiveWorkbook.Close Savechanges:=True

    Change the last Close like above.

    The summary is not being saved before closing.


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Tuesday, August 23, 2016 8:46 AM
    Answerer