Sub test()
On Error Resume Next
Dim list1 As New Collection
For Each Sheet In Worksheets
Dim xx As String
list1.Add Sheet.Name
Next Sheet
For I = 1 To list1.Count
xx = list1.Item(I)
Sheets(xx).Select
ActiveSheet.Name = Range("a7").Value
Next
End Sub
[LEFT]
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[/LEFT]
کامنت