Loop Through Files in a folder


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(Selection, Selection.End(xlDown)).Select
Windows("Loop through files.xlsm").Activate
ActiveCell.Offset(1, 0).Select

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

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