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