ممكن تعديل على الكود ده
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$3" Then
For i = 2 To 1000
x = WorksheetFunction.CountA(Range("b6:b1000"))
If Sheets(2).calls(i, 7) = [$I$3].Value Then
Sheets(5).Cells(6, 2).Offset(x, 0) = Sheets(2).Cells(i, 16)
Sheets(5).Cells(6, 2).Offset(x, 1) = Sheets(2).Cells(i, 4)
Sheets(5).Cells(6, 2).Offset(x, 2) = Sheets(2).Cells(i, 14)
Sheets(5).Cells(6, 2).Offset(x, 3) = Sheets(2).Cells(i, 9)
Sheets(5).Cells(6, 2).Offset(x, 4) = Sheets(2).Cells(i, 10)
End If
Next i
For i = 2 To 1000
x = WorksheetFunction.CountA(Range("b6:b1000"))
If Sheets(3).calls(i, 7) = [$I$3].Value Then
Sheets(5).Cells(6, 2).Offset(x, 0) = Sheets(3).Cells(i, 4)
Sheets(5).Cells(6, 2).Offset(x, 1) = Sheets(3).Cells(i, 19)
Sheets(5).Cells(6, 2).Offset(x, 2) = Sheets(3).Cells(i, 17)
Sheets(5).Cells(6, 2).Offset(x, 3) = Sheets(3).Cells(i, 9)
Sheets(5).Cells(6, 2).Offset(x, 5) = Sheets(3).Cells(i, 10)
Sheets(5).Cells(6, 2).Offset(x, 6) = Sheets(3).Cells(i, 11)
End If
Next i
End If
End Sub