السلام عليكم بعد اذن استاذي / سليم حاصبيا اخى الكريم جرب الكود التالى كأحد طرق الحل Sub Khaled() Dim cll As Range ,Dim Lr As Long Range("C3:C1000").ClearContents For Each cll In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) Lr = Cells(Rows.Count, "C").End(xlUp).Row cll.Copy Destination:=Range("C" & Lr + 1 & ":C" & Lr + cll.Offset(, 1).Value) Next End Sub