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
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

@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. Then see how easy it is to update the Table when new files are dropped into the Folder. 1. (00:10 minute mark) Problem Setup 2. (01:03 ...
Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
23 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
flashing a white screen while open new tab
cntvertex in Discussions on
14 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
28 Replies