Consulting

Results 1 to 12 of 12

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

  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

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,618
    Location
    First Step: I formatted the code in your post to make it legible to programmers
    Second step: I removed all extras the Macro Recorder put in the code. This is almost the same code as in your post. I added some looping as I think you want.
    You will still need to doublecheck it
    Sub Doorvoeren()
        Dim thisWorkbook As Workbook, TestBk As Workbook, ToSht as Worksheet '<--------------------
        Dim fromPath As String
        Dim I As Long
        Dim RowCount As Long
        
            'Get path from cell FT3 on Mulder Montage tab in this book
            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 & "" 'Don't you mean "\" vice ""
      
            RowCount = Cells(Cells.Rows.Count, "T").End(xlDown).Rows.Count
    
           Set TestBk = Workbooks("Test.xlsm")
           Set ToSht = TestBk.ActiveSheet
              
        For I = 2 To RowCount '<-----------------
               Set wkbFrom = Workbooks.Open(fromPath & Sheets("Mulder Montage").Cells(I, "ag"))
            
              'Copy and paste data
              With wkbFrom.Sheets("Werknemer")
                  .Range("Z2:AD2").Copy TestSht.Cells(Rows.Count, "AH").End(xlUp.Offset(1)
                  ' Note that the two pastes below will be overwriting parts of the first paste
                  .Range("AK2:AL2").Copy TestSht.Cells(Rows.Count,"AM").End(xlUp)
                  .Range("BE2").CopyTestSht.Cells(Rows.Count,("AO").End(xlUp)
                  .Close savechanges:=False
               End With
        Next I
        
        MsgBox "Finished"
    End Sub
    It would help us help you if we had some sample workbooks. (See Go Advanced button)
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    Zijn het Excelbestanden of CSV-bestanden ?
    Waarom een Engelstalig forum ?

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,618
    Location
    Because we are the beste
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  5. #5
    VBAX Newbie
    Joined
    May 2021
    Posts
    5
    Location
    Your are right I did a lot of things with the recording button, I am quite new in the VBA-business.
    [QUOTE=SamT;409174]First Step: 'Don't you mean "" vice ""
    This was correct, I think something went wrong during the copy-paste to the forum.

    I get a syntaxerror on the formulas below
    .Range("Z2:AD2").Copy TestSht.Cells(Rows.Count, "AH").End(xlUp.Offset(1)
    .Range("AK2:AL2").Copy TestSht.Cells(Rows.Count,"AM").End(xlUp) <---- This one doesn't get an error
    .Range("BE2").CopyTestSht.Cells(Rows.Count,("AO").End(xlUp)

    The cells don't overwrite. I first copy 5 cells, then 2 and then 1. AH/AI/AJ/AK/AL = 5 ; AM/AN = 2 ; AO = 1, but thanks for checking.

    In the attachments you'll find the test.xlsm and a few lists with hours (which also contain a code of which most of it is recorded, but this one was a lot easier and it works).

    Thanks already for the effort you put in to my code.
    Attached Files Attached Files

  6. #6
    VBAX Newbie
    Joined
    May 2021
    Posts
    5
    Location
    Quote Originally Posted by snb View Post
    Zijn het Excelbestanden of CSV-bestanden? (Are these Excel-files or CSV-files?) These are all Excel-files, see the attachments I've added to my reply to SamT

    Waarom een Engelstalig forum ?
    (Why an English forum?) To get a larger public. And when I'm searching for answers I usually search the English forums, because you'll find more information, more answers and more problems...

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    The best ?

    .Range("Z2:AD2").Copy TestSht.Cells(Rows.Count, "AH").End(xlUp.Offset(1)
    .Range("AK2:AL2").Copy TestSht.Cells(Rows.Count,"AM").End(xlUp)
    .Range("BE2").CopyTestSht.Cells(Rows.Count,("AO").End(xlUp)
    Should be:

    .Range("Z2:AD2").Copy TestSht.Cells(Rows.Count, 34).End(xlUp).Offset(1)
    .Range("AK2:AL2").Copy TestSht.Cells(Rows.Count,39).End(xlUp)
    .Range("BE2").Copy TestSht.Cells(Rows.Count,41).End(xlUp)
    NB. Margriet, de website helpmij.nl kent veel meer deskundige helpers dan het handjevol (ca. 4) hier.
    Last edited by snb; 05-05-2021 at 01:56 AM.

  8. #8
    VBAX Newbie
    Joined
    May 2021
    Posts
    5
    Location
    Unfortunately, the code doesn't open any of the files anymore.

  9. #9
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    What is the meaning of 'the code' ?

    On which grounds do you think so ?

  10. #10
    VBAX Newbie
    Joined
    May 2021
    Posts
    5
    Location
    The meaning is to copy the values of the cells into a overview with al our employees.

    When I delete the part where the TestBk should be closed, none of the TestBk's stay open when the messagebox shows up in my screen.

  11. #11
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,618
    Location
    @snb
    Should be:
          .Range("Z2:AD2").Copy TestSht.Cells(Rows.Count, 34).End(xlUp).Offset(1)
    .Range("AK2:AL2").Copy TestSht.Cells(Rows.Count,39).End(xlUp)
    .Range("BE2").Copy TestSht.Cells(Rows.Count,41).End(xlUp)
    Hmmm... Why aren't the column letters working in that particular instance?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  12. #12
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    Sometimes you forgot a bracket (line 1) , sometimes you added too many (line 3)

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
  •