Consulting

Results 1 to 12 of 12

Thread: Create a loop in VBA to copy data out of different files

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    May 2021
    Posts
    5
    Location

    Create a loop in VBA to copy data out of different files

    I'm trying to help a collegue to write a code to copy data from several other files into one overview. All of our employees are writing there hours in an Excel file, which is saved on the server. I've managed to create a link to the path with the year and week numbers. These paths are variable.
    I've also managed to write a code (see below) that opens the personal hours file of the person in row 2, copy the data to the right cells in row 2 and close the personal file again.
    What I didn't manage yet is to create a loop which opens the file of the employee on row 3/4/5 etc. to copy the data in to there row.

    FT3 = path;
    AG2 and down = filenames;
    AH2, AM2, AO2 and down are for the copied data;

    The code:
     Sub Doorvoeren()
        Dim thisWorkbook As Workbook
        Dim check_value As String
        Dim I As Long
        Dim RowCount As Long
        
            'Get path from cell FT3 on Mulder Montage tab
            fromPath = Sheets("Mulder Montage").Range("FT3")
    
            'Make sure there is a backslash at the end of the from path
            If Right(fromPath, 1) <> "" Then fromPath = fromPath & ""
    
            Set thisWorkbook = ActiveWorkbook
        
            If Right(folderPath, 1) <> "" Then folderPath = folderPath & ""
        
            RowCount = Cells(Cells.Rows.Count, "T").End(xlDown).Rows.Count
              
        For I = 1 To RowCount
               Range("AG2").Select
               fileName = Sheets("Mulder Montage").Range("ag2")
       
               Set wkbFrom = Workbooks.Open(fromPath & fileName)
            
              'Copy and paste data
               Sheets("Werknemer").Select
                  Range("Z2:AD2").Select
                  Selection.Copy
    
               Windows("Test.xlsm").Activate
                  Range("AH2").Select
                  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
        
              Windows(fileName).Activate
                  Range("AK2:AL2").Select
                  Application.CutCopyMode = False
                  Selection.Copy
        
              Windows("Test.xlsm").Activate
                  Range("AM2").Select
                  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
                
              Windows(fileName).Activate
                  Range("BE2").Select
                  Selection.Copy
          
             Windows("Test.xlsm").Activate
                  Range("AO2").Select
                  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
        
              Windows(fileName).Activate
                  ActiveWorkbook.Close savechanges:=False
        Next I
        
        MsgBox "Finished"
    End Sub
    Last edited by SamT; 05-04-2021 at 07:54 AM. Reason: added Code Tags. Idented/Formatted ode

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •