ترتيب وفرز بيانات الجدول اوتوماتيك من الأكبر

[aftfm]

السلام عليكم ورحمة الله وبركاته

لدي جدول وارغب في عمل الترتيب حسب الاعلى لحقول الجدول بناء على اعلى مرتب مثلا

ولكن الترتيب يكون اوتوماتيك بحيث يتم اضافة البيانات في الجدول وبعد الضغط على Enter يتم الترتيب لبقية الجدول حسب الاكبر

تــم اعادة وتعديل رفع الملف ... طالما انك تريد الحل بالأكواد , فكان لزاماً عليك رفع الملف بإمتداد يقبل الأكواد والماكرو مثل XLSM

فرز حسب الاكبر.xlsm

[Ali Mohamed Ali]

وعليكم السلام يمكنك هذا ,بوضع ذلك الكود بحدث الصفحة

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("d:d")) Is Nothing Then
        Range("d1").Sort Key1:=Range("d2"), _
          Order1:=xlDescending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, _
          Orientation:=xlTopToBottom
    End If
End Sub

فرز حسب 1الاكبر.xlsm

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

بعد اذن الاخ علي

لا يتم  الترتيب الا اذا
  1-كان هناك بيانات في الأعمدة  B /  C  / D ( الترقيم لا ضرورة له لانه يتم اوتوماتيكياً)

  2- تمت الكتابة في اول صف غير فارغ 

Option Explicit
Dim RG As Range, Ro
'++++++++++++++++++++++++++++++++++
Private Sub Worksheet_Change(ByVal Salim As Range)
Set RG = Range("A2").CurrentRegion
Ro = RG.Rows.Count
 With Application
  .EnableEvents = False
  .Calculation = xlCalculationManual
  .ScreenUpdating = False
 End With
If Ro = 1 Then GoTo Bay_Bay

If Salim.Row = Ro + 1 And _
     Application.CountA(Cells(Salim.Row, 2) _
     .Resize(, 3)) = 3 Then
     RG.Sort Range("D2"), 2, Header:=1
      With RG.Offset(1).Resize(Ro - 1)
        .Columns(1) = Evaluate("row(1:" & Ro - 1 & ")")
        .HorizontalAlignment = 1
        .InsertIndent 1
        .Font.Size = 18
        .Font.Bold = True
        .Borders.LineStyle = 1
     End With
End If

Bay_Bay:
 With Application
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
  .ScreenUpdating = True
 End With
End Sub

الملف مرفق

Auto_sort.xlsm