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
Pic 2 is the first file the user will select and the only one i want them to select
Pic 2
Pic 3 you can see that in folder 2017 there are several other folders
Pic 3
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
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
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
Pic 2 is the first file the user will select and the only one i want them to select
Pic 2
Pic 3 you can see that in folder 2017 there are several other folders
Pic 3
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
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