Tặng bạn code cùi bắp trong khi chờ giải pháp khác.
Option Explicit
Sub GetData()
Dim lr, lrData, i, z As Long
Dim Arng, Brng As Range
Dim sArr(), sRes()
With Sheet2
lrData = .Range("A" & Rows.Count).End(xlUp).Row
Set Arng = .Range("A2:A" & lrData)
Set Brng = .Range("B2:B" & lrData)
With Sheet1
lr = .Range("A" & Rows.Count).End(xlUp).Row
sArr = .Range("A2:K" & lr).Value
End With
ReDim sRes(LBound(sArr) To UBound(sArr), 1 To 1)
z = 0
For i = LBound(sArr) To UBound(sArr)
If sArr(i, 1) = Arng.Cells(i, 1).Value And sArr(i, 2) = Brng.Cells(i, 1).Value Then
z = z + 1
sRes(z, 1) = sArr(i, 7)
End If
Next i
If z > 0 Then
.Range("D2

15000").ClearContents
.Range("D2").Resize(z, 1).Value = sRes
MsgBox "Done.", vbInformation
Else
MsgBox "Error.", vbExclamation
End If
End With
End Sub