اخوتى
السلام عليكم ورحمة الله
كنت امل من الكود ان ينقل المجال بلا تكرار ولكن دون جدوى فما الخلل
ام الكود تالف
Sub end_report()
Dim c As Range
Dim coll As New Collection
On Error Resume Next
For i = 6 To 200
For Each c In Sheets("saad").[b7:b1500]
coll.Add c.Value
Cells(i, 4) = c.Value
i = i + 1
Next
Next
End Sub
1.rar