السلام عليكم
اخي العزيز tofimoon4
ما هو الذي يقف امامك
اخي كل ما عليك هو الاتي
انشاء صفحة و سمها باسم ترتيب القوائم
و في محرر كودها الصق هذا الكود
Private Sub Worksheet_Activate()
If Range("B1") = "0" Then
Exit Sub
Else
On Error Resume Next
Range("A2:A10000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange
End If
Dim x As Long
Dim LastRow As Long
LastRow = Range("A400").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
Range("A3:A10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
و الخليه B1 بهذه الصفحة بها معادله انسخها ايضا و الصقها في الخليه B1
جرب و قولي ما يحدث و نحن معك الي ان يتم ما تريد
و اعتقد ان يكون هذا سبب المشكله في اول مره يعمل بها الكود في ملف
جديد فقط قم بكتابة 1 في الخليه A3
وبعد ذلك سيكون العمل بشكل عادي فلسبب ما اجهله الان قمت بكتابة شرط
ان الخليه B1 اذا كانت تساوي صفرا لا يعمل الكود و اكيد انا عملت ده لسبب
ما لا اتذكره الان و حتي لا اكون متسرعا و اقولك الغي هذا الشرط
قم بعمل ما قلته لك و ان شاء الله يعمل الملف معاك
تحياتي