Excel copy specific data cell from multiple workbooks to a master file - vba

Question

I have various workbooks with different employee names containing different projectnumbers and hours worked on these projects. I'm trying to get these project numbers filtered out to a master file (zmaster) containing the entire row(s) of a specific project number. I need Excel to filter through the directory (specific folder cointaining all employee hours files) for matches and copy these matches into the zmaster file. The filter is cell A1 of the master file (eg. 300000 in linked picture example). Picture 1 is the master file and picture 2 is an example of the employee hours file.
https://i.stack.imgur.com/OKs68.png (1)
https://i.stack.imgur.com/va2Yn.png (2)
Also, it would be great if Excel would filter out duplicates (eg. week 30 with the exact same hours and employee name already in the master file is most likely duplicate and should be ignored).
I'm pretty new to Excel vba and found/adjusted the following macro's. The first one copies all data from the directory and places it into the master file. The second one filters out the projectnumber matching with cell A1. However, this requires 2 steps and when I run my first macro for the second time it will also collect data already entered into the master file. Also, my second macro places matches in the same row number as where they're placed in the employee hours file and therefore removing earlier observations in the master file placed in the same row (eg. projectnumber 100000 is placed in row 2 of the employee hours file therefore copying to row 2 in the master file, removing the indicator row of the master file).
First macro:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = ("C:\test\”)
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsx" Then
Exit Sub
End If
Workbooks.Open (Filepath & MyFile)
Range("A2:L9").Copy
ActiveWorkbook.Close
erow = Blad1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
MyFile = Dir
Loop
End Sub
Second macro:
Sub finddata()
Dim projectnumber As Integer
Dim finalrow As Integer
Dim i As Integer
Sheets("Blad1").Range("A1:H9").ClearContents
projectnumber = Sheets("Blad1").Range("A1").Value
finalrow = Sheets("Blad1").Range("A30").End(x1Up).row
For i = 1 To finalrow
If Cells(i, 1) = projectnumber Then
Range(Cells(i, 1), Cells(i, 12)).Copy
Range("A100").End(x1Up).Offset(1, 0).PasteSpecial x1pasteformulasandnumberformats
End If
Next i
Range("A1").Select
End sub
Hopefully everything is clear and thanks in advance!

Answer 1

This should work.
Open each file in directory
check that the file name is not zmaster and that it contains xlsx
run through each row in the current file and then combine the range for copying to master file
copy to master file last row plus 1, which is the first empty row
Option Explicit
Sub CopyToMasterFile()
Dim MasterWB As Workbook
Dim MasterSht As Worksheet
Dim MasterWBShtLstRw As Long
Dim FolderPath As String
Dim TempFile
Dim CurrentWB As Workbook
Dim CurrentWBSht As Worksheet
Dim CurrentShtLstRw As Long
Dim CurrentShtRowRef As Long
Dim CopyRange As Range
Dim ProjectNumber As String
FolderPath = "C:\test\"
TempFile = Dir(FolderPath)
Dim WkBk As Workbook
Dim WkBkIsOpen As Boolean
'Check is zmaster is open already
For Each WkBk In Workbooks
If WkBk.Name = "zmaster.xlsx" Then WkBkIsOpen = True
Next WkBk
If WkBkIsOpen Then
Set MasterWB = Workbooks("zmaster.xlsx")
Set MasterSht = MasterWB.Sheets("Blad1")
Else
Set MasterWB = Workbooks.Open(FolderPath & "zmaster.xlsx")
Set MasterSht = MasterWB.Sheets("Blad1")
End If
ProjectNumber = MasterSht.Cells(1, 1).Value
Do While Len(TempFile) > 0
'Checking that the file is not the master and that it is a xlsx
If Not TempFile = "zmaster.xlsx" And InStr(1, TempFile, "xlsx", vbTextCompare) Then
Set CopyRange = Nothing
'Note this is the last used Row, next empty row will be this plus 1
With MasterSht
MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Set CurrentWB = Workbooks.Open(FolderPath & TempFile)
Set CurrentWBSht = CurrentWB.Sheets("Sheet1")
With CurrentWBSht
CurrentShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For CurrentShtRowRef = 1 To CurrentShtLstRw
If CurrentWBSht.Cells(CurrentShtRowRef, "A").Value = ProjectNumber Then
'This is set to copy from Column A to Column L as per the question
If CopyRange Is Nothing Then
'If there is nothing in Copy range then union wont work
'so first row of the work sheet needs to set the initial copyrange
Set CopyRange = CurrentWBSht.Range("A" & CurrentShtRowRef & _
":L" & CurrentShtRowRef)
Else
'Union is quicker to be able to copy from the sheet once
Set CopyRange = Union(CopyRange, _
CurrentWBSht.Range("A" & CurrentShtRowRef & _
":L" & CurrentShtRowRef))
End If ' ending If CopyRange Is Nothing ....
End If ' ending If CurrentWBSht.Cells....
Next CurrentShtRowRef
CopyRange.Select
'add 1 to the master file last row to be the next open row
CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1)
CurrentWB.Close savechanges:=False
End If 'ending If Not TempFile = "zmaster.xlsx" And ....
TempFile = Dir
Loop
End Sub