Excel VBA code for Looping through files and copying specific data to one file

Question

I am new to VBA and If anyone can help, I'd greatly appreciate it. I just need help in simple VBA loop in following code. I am trying to loop through excel files in a folder and copy specific data from source Worksheet in all files to a new workbook (sheet 2). I have a code which does 70% of the job but I am having difficulty in picking some data and copying it in specific format.

    Option Explicit  

    Const FOLDER_PATH = "C:\Temp\" '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
            Dim FirstRow As Long, LastRow As Long
    FirstRow = 1
    LastRow = 5
   Dim RowRange As Range
        rowTarget = 2 

         '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("Sheet2") 

         '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 = Sheets("DispForm") 'EDIT IF NECESSARY

             'import the data
     With wsTarget
     For Each rw In RowRange
         If wsSource.Cells(rw.Row, 1) & wsSource.Cells(rw.Row + 1, 1) = "" Then
         Exit For
         End If

           .Range("A" & rowTarget).Value = wsSource.Range("B1").Value
              .Range("B" & rowTarget).Value = wsSource.Cells(rw.Row, 2)

              .Range("C" & rowTarget).Value = wsSource.Cells(rw.Row, 4)

              .Range("D" & rowTarget).Value = sFile
               rowTarget = rowTarget + 1
         Next rw

    End With


             'close the source workbook, increment the output row and get the next file
            wbSource.Close SaveChanges:=False 
            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

you only copy one row of data from your source file. so you need either to have a loop inside your file loop to loop all the rows, or to have a range to select all the rows.

try something like the following:

    Dim FirstRow As Long, LastRow As Long
    FirstRow = 9
    LastRow = 100

    Set rowRange = wsSource.Range("A" & FirstRow & ":A" & LastRow)

    With wsTarget
        For Each rw In rowRange
            If wsSource.Cells(rw.Row, 2) = "" Then
            Exit For
            End If

             .Range("A" & rowTarget).Value = wsSource.Cells(rw.Row, 2)
             .Range("B" & rowTarget).Value = wsSource.Cells(rw.Row, 3)
        Next rw
    End With