SAYFALARI SIRALAMA

[redje]

İYİ ÇALIŞMALAR SAYFA1 SAYFA2 SAYF3 GİBİ SAYFALARIN BEN ADINI DEĞİŞTİRİP NUMARALANDIRDIM BUNLARI KÜÇÜKTEN BÜYÜĞE DOĞRU SIRALAMAK İSTİYORUM MÜMKÜNMÜ
YARDIMLARINIZ İÇİN TEŞEKKÜRLER

 

[szaim]

Mouse ile sayfa sekmesinden tutun ve ıstediğiniz yere sürükleyin..

 

[hamitcan]

Aşağıdaki kodları nerden bulduğumu hatırlamıyorum ama işinizi görür sanırım.

Sub SortSheets()
' This routine sorts the sheets of the
' active workbook in ascending order.

Dim SheetNames() As String
Dim i As Integer
Dim SheetCount As Integer
Dim VisibleWins As Integer
Dim Item As Object
Dim OldActive As Object

' Check for protected workbook structure
If ActiveWorkbook.ProtectStructure Then
MsgBox ActiveWorkbook.Name & " is protected.", _
vbCritical, "Cannot Sort Sheets"
Exit Sub
End If

' Disable Ctrl+Break
Application.EnableCancelKey = xlDisabled

' Exit if no windows are visible
VisibleWins = 0
For Each Item In Windows
If Item.Visible Then VisibleWins = VisibleWins + 1
Next Item
If VisibleWins = 0 Then Exit Sub

' Get the number of sheets
SheetCount = ActiveWorkbook.Sheets.Count

' Redimension the array
ReDim SheetNames(1 To SheetCount)

' Store a reference to the active sheet
Set OldActive = ActiveSheet

' Fill array with sheet names and hidden status
For i = 1 To SheetCount
SheetNames(i) = ActiveWorkbook.Sheets(i).Name
Next i

' Sort the array in ascending order
Call BubbleSort(SheetNames)

' Turn off screen updating
Application.ScreenUpdating = False

' Move the sheets
For i = 1 To SheetCount
ActiveWorkbook.Sheets(SheetNames(i)).Move _
ActiveWorkbook.Sheets(i)
Next i

' Reactivate the original active sheet
OldActive.Activate
End Sub



Sub BubbleSort(List() As String)
'‘ Sorts the List array in ascending order
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp

First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If UCase(List(i)) > UCase(List(j)) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub

 

[Seyit Tiken]

Bu kod sayfaları küçükten büyüğe doğru sıralar.

Sub Autpen()
Dim i As Integer
Dim j As Integer
If Worksheets.Count = 1 Then Exit Sub
For i = 1 To Worksheets.Count - 1
For j = i + 1 To Worksheets.Count
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move before:=Worksheets(i)
End If
Next j
Next i
End Sub

 

[redje]

YARDIMLARINIZ İÇİN ÇOK TEŞEKKÜRLER
İŞİMİ GÖRDÜ