Loop through the files in a folder - vba

Question

I have built some code to loop through multiple files in a folder and then try to consolidate in one sheet.
I am mostly able to accomplish that, but it is failing whenever my source file has only one line item to copy.
It is 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 the code fails when I have only one line item.
And also need to help to change the target sheet: I need to paste it into a new workbook.
Below is my code:
Option explicit
Const FOLDER_PATH = "C:\Users\1\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

Answer 1

Try this. If all your workbooks start at A7, and there are no empty columns or rows, .CurrentRegion is much better than trying to figure out first, last row and column
Option Explicit
Const FOLDER_PATH = "C:\Users\1\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 = True
'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").CurrentRegion.Copy
Windows("Loop through files.xlsm").Activate
Range("A1048576").Select
Selection.End(xlUp).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