Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet, x As Long, lr As Long, j As Integer
Dim qt1 As Integer, qt2 As Integer, qt3 As Integer, qt4 As Integer, qt5 As Integer
Set ws1 = Sheets("data")
Set ws2 = Sheets("Tool")
lr = ws2.Range("R" & Rows.Count).End(xlUp).Row
If lr > 4 Then ws2.Range("R5", "W" & lr).ClearContents
For x = 5 To 9
If Application.CountA(ws2.Range("C" & x, "F" & x)) = 4 Then j = j + 1
Next
lr = ws2.Range("I" & Rows.Count).End(xlUp).Row
For x = 5 To lr
qt1 = Application.CountIfs(ws1.Range("C:C"), ws2.Range("I" & x), ws1.Range("B:B"), ws2.Range("C5"), ws1.Range("E:E"), ws2.Range("D5"), ws1.Range("D:D"), ws2.Range("E5"), ws1.Range("F:F"), ws2.Range("F5"))
qt2 = Application.CountIfs(ws1.Range("C:C"), ws2.Range("I" & x), ws1.Range("B:B"), ws2.Range("C6"), ws1.Range("E:E"), ws2.Range("D6"), ws1.Range("D:D"), ws2.Range("E6"), ws1.Range("F:F"), ws2.Range("F6"))
qt3 = Application.CountIfs(ws1.Range("C:C"), ws2.Range("I" & x), ws1.Range("B:B"), ws2.Range("C7"), ws1.Range("E:E"), ws2.Range("D7"), ws1.Range("D:D"), ws2.Range("E7"), ws1.Range("F:F"), ws2.Range("F7"))
qt4 = Application.CountIfs(ws1.Range("C:C"), ws2.Range("I" & x), ws1.Range("B:B"), ws2.Range("C8"), ws1.Range("E:E"), ws2.Range("D8"), ws1.Range("D:D"), ws2.Range("E8"), ws1.Range("F:F"), ws2.Range("F8"))
qt5 = Application.CountIfs(ws1.Range("C:C"), ws2.Range("I" & x), ws1.Range("B:B"), ws2.Range("C9"), ws1.Range("E:E"), ws2.Range("D9"), ws1.Range("D:D"), ws2.Range("E9"), ws1.Range("F:F"), ws2.Range("F9"))
If j = qt1 + qt2 + qt3 + qt4 + qt5 Then ws2.Range("R" & Rows.Count).End(xlUp).Offset(1).Resize(, 6).Value = ws2.Range("H" & x, "M" & x).Value
Next
End Sub
Kind regards
Bookmarks