Loop through the files in a folder

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

Your question has nothing to do with looping through files in a folder but is rather about processing a particular type of file. Why not focus the question on the actual problem? In any event, you could benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/q/10714251/4996248). To solve your actual problem, start on the *bottom* row of the column and use `.End(xlUp)` See [Find bottom of Excel worksheet](https://stackoverflow.com/q/4092329/4996248) — John Coleman, May 31 '19 at 15:04
maybe you could just throw in an if statement, if file has only one line copy, otherwise do your thing — Mr.Riply, May 31 '19 at 15:22

score 0 · Answer 1 · answered May 31 '19 at 15:47

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

Loop through the files in a folder

1 Answers1