با سلام
این کد رو امتحان کنید.
کد:
Sub SortByCell()
Dim i, j As Integer
Dim WorkRng As Range
Dim WorkAddress As String
On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Range("a7")
WorkAddress = WorkRng.Address
Application.ScreenUpdating = False
For i = 1 To Application.Worksheets.Count
For j = i To Application.Worksheets.Count
If VBA.UCase(Application.Worksheets(j).Range(WorkAddress)) < VBA.UCase(Application.Worksheets(i).Range(WorkAddress)) Then
Application.Worksheets(j).Move Before:=Application.Worksheets(i)
End If
Next
Next
Application.ScreenUpdating = True
End Sub
علاقه مندی ها (Bookmarks)