Search code examples
excelvbaloopscopy-paste

Loop through files in folder, post content to empty columns in master, for each source file in a new row of the master-file


I'm very new to VBA and I'm working on a project where I've got multiple Excel files in a folder, each structured the same way, and I want to loop through each of them, search for specific terms in each single file, copy it, and paste it to the master-file in a specific way.

I already got everything except pasting it the right way:

Every term it finds in a source-file should be posted to the next empty column in the master file and for each new source-file the loop goes through, it should post the stuff it finds to a new row in the master file.

Below is what I've already got.

Private Const sPath As String = "F:\ExamplePath"


Sub LoopThroughFiles()

Dim sFile As String 'File Name
Dim sExt As String 'File extension 
    
    sExt = "xlsx" 
    
    'loop through each file name and open it if the extension is correct
    sFile = Dir(sPath)
    Do Until sFile = ""
        If Right(sFile, 4) = sExt Then GetInfo sFile
        sFile = Dir
    Loop


End Sub

Private Sub GetInfo(sFile As String)

Dim wbFrom As Workbook 'workbook to copy the data from
Dim iRow As Integer 'row number of next empty row
Dim cl As Range
Dim strAddress As String

 On Error GoTo errHandle
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Set wbFrom = Workbooks.Open(sPath & sFile)
    
    
    
    'finds Search-Term
    With wbFrom.Sheets(1).Cells
    Set cl = .Find("necrosis_left", After:=.Range("C2"), LookIn:=xlValues)
        If Not cl Is Nothing Then
            strAddress = cl.Address
            cl.Select
            Selection.Copy
        iRow = Me.Range("A" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
        Me.Range("A" & iRow).PasteSpecial xlPasteAll 'past copied cells
        End If
     End With
        
        
    'finds other Search-Term
    With wbFrom.Sheets(1).Cells
    Set cl = .Find("necrosis_right", After:=.Range("C2"), LookIn:=xlValues)
        If Not cl Is Nothing Then
            strAddress = cl.Address
            cl.Select
            Selection.Copy
        iRow = Me.Range("A" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
        Me.Range("A" & iRow).PasteSpecial xlPasteAll 'past copied cells
        End If
     End With
       
   'many more search terms


    
       wbFrom.Close (False)
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Set wbFrom = Nothing
    
Exit Sub
errHandle:
MsgBox Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
        
    
End Sub

So I do know, that my problem is located here:

iRow = Me.Range("A" & Rows.Count).End(xlUp).Row + 1 'Get an empty row in this workbook
Me.Range("A" & iRow).PasteSpecial xlPasteAll 'past copied cells

But I can't quite figure out how it posts to an empty column instead of an empty row, not to speak of how to make it go down a row in the master file for each new source file.


Solution

  • Found the answer to my own question!

    The first step was to replace the "paste-line" above with the following:

    Me.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll
    

    This pastes every copied cell to the next empty column in line 1.

    To start a new line for every source-file the loop goes through, a public variable had to be declared, which counted up each iteration. The final code looks like this:

    Private Const sPath As String = 'enter your path
    Public Zeile As Integer 'public variable
    
    
    Sub LoopThroughFiles()
    
    Dim sFile As String 'File Name
    Dim sExt As String 'File extension you wish to open
        
        
       Zeile = 1 'important for not start pasting in row 0 (which is impossible)
        sExt = "xlsx" 'Change this if extension is different
        
        'loop through each file name and open it if the extension is correct
        sFile = Dir(sPath)
        Do Until sFile = ""
            If Right(sFile, 4) = sExt Then GetInfo sFile
            sFile = Dir
            Zeile = Zeile + 1 'goes up each iteration
        Loop
    
    
    End Sub
    
    Private Sub GetInfo(sFile As String)
    
    Dim wbFrom As Workbook 'workbook to copy the data from
    Dim iRow As Integer 'row number of next empty row
    Dim cl As Range
    Dim strAddress As String
    
     On Error GoTo errHandle
     
        Application.EnableEvents = False
        Application.ScreenUpdating = False
     
        Set wbFrom = Workbooks.Open(sPath & sFile)
        
       
         'copy the following block for each term you want to search for
        With wbFrom.Sheets(1).Cells
        Set cl = .Find("searchterm", After:=.Range("C2"), LookIn:=xlValues)
            If Not cl Is Nothing Then
                strAddress = cl.Address
                cl.Select
                Selection.Copy
           Me.Cells(Zeile, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll 'the rows are controlled via the public variable 
            End If
         End With
    
          wbFrom.Close (False)
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Set wbFrom = Nothing
        
    Exit Sub
    errHandle:
    MsgBox Err.Description
        Application.EnableEvents = True
        Application.ScreenUpdating = True
            
        
    End Sub
    
    

    The result loops through all files of a folder, searches for a specific term and pastes each result in the next empty column of the master file, but starts a new row for each source file.

    Thanks though!