فرز متعدد

[ناصر سعيد]

فرز لجدول كامل انت تحدده وبعلوميه اي عمود تبغاه

Option Explicit
Sub SortTable()

  'code written by Dave Peterson 2005-10-22
  Dim myTable As Range
  Dim myColToSort As Long
  Dim curWks As Worksheet
  Dim mySortOrder As Long
  Dim LastRow As Long
  Dim iCol As Integer
  Dim strCol As String
  iCol = 20  '10 columns
  strCol = "b"  ' column to check for last row

  Set curWks = ActiveSheet
  With curWks
    myColToSort = .Shapes(Application.Caller).TopLeftCell.Column
    LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
    Set myTable = .Range("a6:a" & LastRow).Resize(, iCol)
    If .Cells(myTable.Row + 1, myColToSort).Value _
      < .Cells(LastRow, myColToSort).Value Then
        mySortOrder = xlDescending
    Else
        mySortOrder = xlAscending
    End If
    myTable.Sort key1:=.Cells(myTable.Row, myColToSort), _
              order1:=mySortOrder, _
              header:=xlYes
  End With

End Sub

فرز راائع.rar

[ياسر خليل أبو البراء]

أخي الكريم ناصر سعيد

بارك الله فيك وجزاك الله خيراً على هذا النشاط

 

الملف لا يعمل أخي الفاضل

يرجى تغيير اسم الظهور للغة العربية

[ناصر سعيد]

اشكرك اخي على تنبيهك لي بتغيير اسم الظهور

الملف يعمل تماما وهو 2003