اخى ياسر
مشكورا على المساعده
نعلم ان وقتك لا يتسع للجميع
الكود ياتى بالنتائج بالفعل
ولكنى اريدها بطريقه معينه
الا وهى استخراج كل رقم لوحده
ثم ترك سطر او سطرين فارغين بين كل رقمتم اضافه
حلقه تكرارايه الى الكود
فتم استخراج النتائج بالترتيب
باق كيفيه جعل الكود يقوم بترك صف فارغ
تقبل تحياتى
CODE
Sub Test()
T = Timer
Dim v, x, rng As Range, lr As Long, r As Long, m As Long
Application.ScreenUpdating = False
With Sheet1
.Columns("J:M").ClearContents
v = .Range("A1").Value
Set rng = .Range("H1:H" & .Cells(Rows.Count, "H").End(xlUp).Row)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
m = 1
For h = 1 To 3
For r = 3 To lr
If .Cells(r, 1).Value = v Then
If .Cells(r, 3).Value = h Then
.Range("J" & m).Resize(, 4).Value = .Cells(r, 1).Resize(, 4).Value
m = m + 1
'' x = Application.Match(.Cells(r, 3).Value, rng, 0)
'If Not IsError(x) Then
' End If
End If
End If
Next
Next
End With
Application.ScreenUpdating = True
MsgBox Timer - T