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:

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

---

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

Code:

---

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)

Zijn het Excelbestanden of CSV-bestanden ?
Waarom een Engelstalig forum ?

Because we are the beste

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:dunno
.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. :bow:

Quote:

---

Originally Posted by snb

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...

The best ? :whistle:

Quote:

---

.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:

Code:

---

.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.

Unfortunately, the code doesn't open any of the files anymore.

What is the meaning of 'the code' ?

On which grounds do you think so ?

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.

@snb

Quote:

---

Should be:

Code:

---

      .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?

Sometimes you forgot a bracket (line 1) , sometimes you added too many (line 3)