Home

Loop Through Files in a folder

%3CLINGO-SUB%20id%3D%22lingo-sub-660904%22%20slang%3D%22en-US%22%3ELoop%20Through%20Files%20in%20a%20folder%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-660904%22%20slang%3D%22en-US%22%3E%3CP%3EHello%20All%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20built%20a%20code%20to%20loop%20through%20multiple%20files%20in%20a%20folder%20and%20then%20try%20to%20consolidate%20in%20one%20sheet.%3C%2FP%3E%3CP%3EI%20am%20able%20to%20accomplish%20but%20i%20am%20failing%20when%20ever%20my%20source%20file%20have%20only%20one%20line%20item%20to%20copy.%3C%2FP%3E%3CP%3EI%20am%20failing%20at%20code%20%22%26nbsp%3BRange(Selection%2C%20Selection.End(xlDown)).Select%22%20.%20I%20used%20this%20to%20copy%20entire%20rows%20from%20A7%20row.%20It%20works%20when%20i%20have%20more%20than%20one%20line%20item.%20But%20code%20fails%20when%20i%20have%20only%20one%20line%20item.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EAnd%20also%20need%20to%20help%20to%20change%20the%20target%20sheet.%20i%20need%20to%20paste%20it%20in%20new%20workbook%20than%20this%20work%20book.%20Below%20is%20my%20code%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ENeed%20help%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EOption%20explicit%3C%2FP%3E%3CP%3E%3CBR%20%2F%3EConst%20FOLDER_PATH%20%3D%20%22C%3A%5CUsers%5Ch140738%5CDesktop%5CNew%20folder%20(4)%5C%22%20'REMEMBER%20END%20BACKSLASH%3C%2FP%3E%3CP%3E%3CBR%20%2F%3ESub%20ImportWorksheets()%3CBR%20%2F%3E'%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3CBR%20%2F%3E'Process%20all%20Excel%20files%20in%20specified%20folder%3CBR%20%2F%3E'%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3D%3CBR%20%2F%3EDim%20sFile%20As%20String%20'file%20to%20process%3CBR%20%2F%3EDim%20wsTarget%20As%20Worksheet%3CBR%20%2F%3EDim%20wbSource%20As%20Workbook%3CBR%20%2F%3EDim%20wsSource%20As%20Worksheet%3CBR%20%2F%3EDim%20rowTarget%20As%20Long%20'output%20row%3CBR%20%2F%3E%3CBR%20%2F%3ErowTarget%20%3D%207%3CBR%20%2F%3E%3CBR%20%2F%3E'check%20the%20folder%20exists%3CBR%20%2F%3EIf%20Not%20FileFolderExists(FOLDER_PATH)%20Then%3CBR%20%2F%3EMsgBox%20%22Specified%20folder%20does%20not%20exist%2C%20exiting!%22%3CBR%20%2F%3EExit%20Sub%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3E%3CBR%20%2F%3E'reset%20application%20settings%20in%20event%20of%20error%3CBR%20%2F%3EOn%20Error%20GoTo%20errHandler%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20False%3CBR%20%2F%3E%3CBR%20%2F%3E'set%20up%20the%20target%20worksheet%3CBR%20%2F%3ESet%20wsTarget%20%3D%20Sheets(%22Sheet1%22)%3CBR%20%2F%3E%3CBR%20%2F%3E'loop%20through%20the%20Excel%20files%20in%20the%20folder%3CBR%20%2F%3EsFile%20%3D%20Dir(FOLDER_PATH%20%26amp%3B%20%22*.xls*%22)%3CBR%20%2F%3EDo%20Until%20sFile%20%3D%20%22%22%3CBR%20%2F%3E%3CBR%20%2F%3E'open%20the%20source%20file%20and%20set%20the%20source%20worksheet%20-%20ASSUMED%20WORKSHEET(1)%3CBR%20%2F%3ESet%20wbSource%20%3D%20Workbooks.Open(FOLDER_PATH%20%26amp%3B%20sFile)%3CBR%20%2F%3ESet%20wsSource%20%3D%20wbSource.Worksheets(1)%20'EDIT%20IF%20NECESSARY%3CBR%20%2F%3E%3CBR%20%2F%3E'import%20the%20data%3CBR%20%2F%3E%3CBR%20%2F%3EWith%20wsTarget%3CBR%20%2F%3ERange(%22A7%3ABI7%22).Select%3CBR%20%2F%3ERange(Selection%2C%20Selection.End(xlDown)).Select%3CBR%20%2F%3ESelection.Copy%3CBR%20%2F%3EWindows(%22Loop%20through%20files.xlsm%22).Activate%3CBR%20%2F%3ERange(%22A2%22).Select%3CBR%20%2F%3ESelection.End(xlDown).Select%3CBR%20%2F%3EActiveCell.Offset(1%2C%200).Select%3CBR%20%2F%3EActiveSheet.PasteSpecial%3CBR%20%2F%3E%3CBR%20%2F%3E%3CBR%20%2F%3EEnd%20With%3CBR%20%2F%3E%3CBR%20%2F%3E'close%20the%20source%20workbook%2C%20increment%20the%20output%20row%20and%20get%20the%20next%20file%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20False%3CBR%20%2F%3EwbSource.Close%20SaveChanges%3A%3DFalse%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20True%3CBR%20%2F%3ErowTarget%20%3D%20rowTarget%20%2B%201%3CBR%20%2F%3EsFile%20%3D%20Dir()%3CBR%20%2F%3ELoop%3CBR%20%2F%3E%3CBR%20%2F%3EerrHandler%3A%3CBR%20%2F%3EOn%20Error%20Resume%20Next%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20True%3CBR%20%2F%3E%3CBR%20%2F%3E'tidy%20up%3CBR%20%2F%3ESet%20wsSource%20%3D%20Nothing%3CBR%20%2F%3ESet%20wbSource%20%3D%20Nothing%3CBR%20%2F%3ESet%20wsTarget%20%3D%20Nothing%3CBR%20%2F%3EEnd%20Sub%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CBR%20%2F%3EPrivate%20Function%20FileFolderExists(strPath%20As%20String)%20As%20Boolean%3CBR%20%2F%3EIf%20Not%20Dir(strPath%2C%20vbDirectory)%20%3D%20vbNullString%20Then%20FileFolderExists%20%3D%20True%3CBR%20%2F%3EEnd%20Function%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-660904%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-663265%22%20slang%3D%22en-US%22%3ERe%3A%20Loop%20Through%20Files%20in%20a%20folder%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-663265%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F152352%22%20target%3D%22_blank%22%3E%40Chandrakanth%20K%3C%2FA%3E%26nbsp%3BDo%20you%20want%2Fneed%20to%20do%20this%20in%20VBA%3F%20Power%20Query%20can%20do%20this%20easily.%20See%20an%20example%20here%26nbsp%3B%3CA%20href%3D%22https%3A%2F%2Fwww.youtube.com%2Fwatch%3Fv%3Da7E29H5ZUmE%22%20target%3D%22_blank%22%20rel%3D%22nofollow%20noopener%20noreferrer%20noopener%20noreferrer%22%3Ehttps%3A%2F%2Fwww.youtube.com%2Fwatch%3Fv%3Da7E29H5ZUmE%3C%2FA%3E%3C%2FP%3E%3C%2FLINGO-BODY%3E
Highlighted
Chandrakanth K
Contributor

Hello All,

 

I have built a code to loop through multiple files in a folder and then try to consolidate in one sheet.

I am able to accomplish but i am failing when ever my source file have only one line item to copy.

I am failing at code " Range(Selection, Selection.End(xlDown)).Select" . I used this to copy entire rows from A7 row. It works when i have more than one line item. But code fails when i have only one line item.

 

And also need to help to change the target sheet. i need to paste it in new workbook than this work book. Below is my code

 

Need help

 

Option explicit


Const FOLDER_PATH = "C:\Users\h140738\Desktop\New folder (4)\" 'REMEMBER END BACKSLASH


Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row

rowTarget = 7

'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If

'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False

'set up the target worksheet
Set wsTarget = Sheets("Sheet1")

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""

'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY

'import the data

With wsTarget
Range("A7:BI7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Loop through files.xlsm").Activate
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.PasteSpecial


End With

'close the source workbook, increment the output row and get the next file
Application.DisplayAlerts = False
wbSource.Close SaveChanges:=False
Application.DisplayAlerts = True
rowTarget = rowTarget + 1
sFile = Dir()
Loop

errHandler:
On Error Resume Next
Application.ScreenUpdating = True

'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub

 


Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

1 Reply
Highlighted

@Chandrakanth K Do you want/need to do this in VBA? Power Query can do this easily. See an example here https://www.youtube.com/watch?v=a7E29H5ZUmE

Download file: http://people.highline.edu/mgirvin/excelisfun.htm See how to use Power Query to import multiple Excel Files into an Excel Table or Data Model....