نسخ خلية من شيت لاخر بشرط

[Ali994m]

السلام عليكم 

أرجو المساعدة في اضافة دالة لنسخ من شيت لاخر في حال تحقق الشرط أي يتم نسخ قيمة C3 في حال كانت قيمة B3 لاتساوي الصفر 

وجزاكم الله كل خير

نسخ بشرط.xlsm

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

Sub test()
With Sheets("الجمعة")
    a = .Range("b3:c" & .Cells(Rows.Count, 3).End(xlUp).Row - 2)
    ReDim b(1 To 1)
    l = 1
    For i = 1 To UBound(a)
        If a(i, 1) <> 0 Then
            b(l) = a(i, 2)
          l = l + 1
        End If
        ReDim Preserve b(1 To l)
    Next
    With Sheets("re")
    Cells(12, 2).Resize(UBound(b) - 1) = Application.Transpose(b)
    End With
    End With
End Sub

 

[سليم حاصبيا]

بعد اذن الاخ أبو البشر هذا الكود ( لا يسمح بتكرار الأسماء)

Option Explicit
Sub test()

Dim i%
Dim Obj As Object

Set Obj = CreateObject("Scripting.Dictionary")
Sheets("re").Cells(12, 1).Resize(15, 3).ClearContents
i = 3

With Sheets("الجمعة")
    Do While .Cells(i, 3).Value <> ""
        If .Cells(i, 2) <> vbNullString Then
        Obj(.Cells(i, 3).Value) = vbNullString
        End If
      i = i + 1
    Loop
End With

If Obj.Count Then
    With Sheets("re").Cells(12, 2).Resize(Obj.Count)
     .Value = Application.Transpose(Obj.keys)
     .Offset(, -1) = Evaluate("Row(1:" & Obj.Count & ")")
     End With
End If
Set Obj = Nothing
End Sub