السلام عليكم
اخي dayslife
Private Sub Worksheet_Activate() في حدث التفعيل للشيت
If Range("B1") = "0" Thenاذا كانت الخلية B1=0
Exit Sub يتوقف عمل الكود
Else اذا لم تكن =0
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
تحياتي