نقل البيانات الغير متكررة في نطاق الى ورقة عمل اخرى

[amr atef eid]

السادة الافاضل مرفق طيه ملف به ورقتي عمل الاولى بها نطاق باسم moha ابحث عن دالة او ماكرو ويفضل دالة لنقل صفوف الاسماء الغير متكررة في ورقة عمل اخرى

شاكر لحضراتكم الاهتمام 

االتجميع والاساسى المحدث عاطف 1.rar

[أبو حنــــين]

السلام عليكم

بالكود يكون الحل كالتالي :

Sub Duplicata()

Dim i As Long, Last As Long
With Sheets("بيانات غير متكررة")
.Range("A2:Q" & .Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
End With
Set MySheet = Sheets("الاساسى")
With MySheet
Last = .Cells(Rows.Count, "B").End(xlUp).Row + 1
x = 2
Application.ScreenUpdating = False

        For i = .Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(.Range("B2:B" & i), .Range("B" & i).Value) = 1 Then
.Range("A" & i).Resize(1, 17).Copy
Sheets("بيانات غير متكررة").Range("A" & x).PasteSpecial Paste:=xlPasteValues
x = x + 1
            End If
        Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True

End With
End Sub

[جمال عبد السميع]

ماشاء الله أخى وأستاذى ( أبو حنين )

كود فى منتهى الجمال

ونصيحة لأخى ( AMR )

لاتبحث عن المعادلة فى هذا الكم من البيانات لأنها ستكون معادلة صفيف وستسبب ثقل شديد فى الشيت

فحل أخى ( أبو حنين )

هو الحل الأمثل ، بعد تجربة المعادلة

تقبل : تحياتى

[amr atef eid]

 

السلام عليكم

بالكود يكون الحل كالتالي :

Sub Duplicata()

Dim i As Long, Last As Long
With Sheets("بيانات غير متكررة")
.Range("A2:Q" & .Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
End With
Set MySheet = Sheets("الاساسى")
With MySheet
Last = .Cells(Rows.Count, "B").End(xlUp).Row + 1
x = 2
Application.ScreenUpdating = False

        For i = .Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(.Range("B2:B" & i), .Range("B" & i).Value) = 1 Then
.Range("A" & i).Resize(1, 17).Copy
Sheets("بيانات غير متكررة").Range("A" & x).PasteSpecial Paste:=xlPasteValues
x = x + 1
            End If
        Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True

End With
End S

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