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