محتاج كود ترحيل يكون سهل وبسيط ( ترحيل بشرط )

[Wael Hamed_1975]

الأخوة الافاضل السلام عليكم ورحمة الله وبركاتة.محتاج كود ترحيل بشرط ناجح أو راسب

وشكرا جزيلا

MY_RESULT.xlsm

[عبدالفتاح في بي اكسيل]

مجرد تخمين 

Sub Button1_Click()
 Dim i As Long
 For i = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
 If Sheet1.Cells(i, 3) = "ناجح" Or Sheet1.Cells(i, 3) = "راسب" Then
 Sheet1.Range("a" & i & ":c" & i).Copy Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
 End If
 Next
End Sub

 

[Wael Hamed_1975]

كود ترحيل الناجحين ممكن طريقة الكود الصحيحة

[احمد عبدالحليم]

تفضل اخى هذا كود بحث وليس ترحيل جرب الملف

MY_RESULT.xlsm

[محي الدين ابو البشر]

حل آخر

Sub test()
    Dim a
    Dim i&
    a = Sheets("DATA").Cells(1).CurrentRegion
    With CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
    If a(i, 3) = Sheets("RESULT").Cells(1, 5) Then
   If Not .exists(a(i, 1)) Then .Add a(i, 1), Array(a(i, 1), a(i, 2), a(i, 3))
   End If
    Next
    a = Application.Index(.items, 0, 0)
    End With
    With Sheets("RESULT").Cells(1).CurrentRegion.Offset(1)
.ClearContents
  .Resize(UBound(a), 3) = a
    End With
End Sub

 

تم تعديل أغسطس 20, 2023 بواسطه محي الدين ابو البشر