VBA Loop through folder and subfolders to find specific sheet then Copy and Paste certain data

Conell8383

Board Regular
Joined
Jul 26, 2016
Messages
66
I hope you can help. I have made an attempt to code this myself (see code below) but failed so I am reaching out to the community for assistance.
What I need my code to do is allow a user to click on a command button, then the user selects a folder. Once this folder is selected. I need the code to look or loop through this folder and all the subfolders in this folder and find sheets with a name Like "CustomerExp" then copy the the data in sheets name Like "CustomerExp" from the second row down to the last used row and paste the information into a sheet called "Disputes" where the macro is housed.
I have supplied pictures for better understanding.
Pic 1 is where the macro is housed and where i need the info pasted to.

Pic 1
xfrPBPO.png


Pic 2 is the first file the user will select and the only one i want them to select
Pic 2
WKaF1mA.png



Pic 3 you can see that in folder 2017 there are several other folders
Pic 3

RqGgVBD.png



Pic 4 Again you can see that we have the file I am looking for plus more folders that need to be looped through
Pic 4
94HugyO.png



Essentially what I need the code to do is allow the person to select 2017 folder click ok and then the code goes through everything in the 2017 folder finds the files with names Like "CustomerExp" copies data and pastes to the sheet "Disputes" in the sheet where the macro is held.
My code currently only works on one folder. I need it to loop through all folders. As always any and all help is greatly appreciated.
MY CODE


Code:
Sub LoopAllExcelFilesInFolder()


'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long
Dim ws2 As Worksheet
Dim y As Workbook










'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 = "C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Looper\"
    .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)


Set y = ThisWorkbook
Set ws2 = y.Sheets("Disputes")


'Loop through each Excel file in folder
Do While myFile <> ""


    If myFile Like "*CustomerExp*" Then


        'Set variable equal to opened workbook
        Set wb = Workbooks.Open(Filename:=myPath & myFile)


        'Copy data on first sheet on workbook to "Disputes" Sheet in other workbook
        With wb.Sheets(1)
            lRow = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
        End With


        wb.Close SaveChanges:=True


    End If


    '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


End Sub
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Forum statistics

Threads
1,216,074
Messages
6,128,649
Members
449,462
Latest member
Chislobog

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top