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