كود ترتيب اسماء الصفحات تصاعديا و تنازليا

[جلال الجمال_ابو أدهم]

تم رفع هذا الكود فى مشاركة منفصله

حتى لا ننسى هذه المشاركة    هل يمكن ترتيب اسماء شيت الاكسيل ابجدي

                                                    

 

تم ارفاق كود الحل من الفاضل_ أ / أبوعبد الله            ترتيب الأوراق حسب أسمائها (abdalah).rar

 

               و مشاركة من الفاضل _ أ / طارق محمود      sort_sheets_tarek.rar

يتم تشغيله عن طريق

Alt-F8

ثم تختار

sortsheets

RUN

Sub sortsheets()

Dim sh_name(99), nw_sh(99) As Variant


'Read Sheet names

x = Worksheets.Count

For i = 1 To x

 sh_name(i) = Sheets(i).Name

 nw_sh(i) = sh_name(i)

Next i


'Sort Sheet names

	For i = 1 To x

 	For j = i + 1 To x

 	If nw_sh(j) < nw_sh(i) Then exchg = nw_sh(j): nw_sh(j) = nw_sh(i): nw_sh(i) = exchg

 	Next j

	Next i


 For i = x To 1 Step -1

	Sheets(nw_sh(i)).Move Before:=Sheets(1)

	Next i


End Sub

وهذا للترتيب التصاعدي وللترتيب التنازلي تغير آخر سطور من

 

 For i = x To 1 Step -1

	Sheets(nw_sh(i)).Move Before:=Sheets(1)

	Next i

إلي 

 For i = 1 To x

	Sheets(nw_sh(i)).Move Before:=Sheets(1)

	Next i

و مشاركة من الفاضل _ أ /   أيسم إبراهيم 

Sub SortABC()

Dim i As Integer, j As Integer, x As Integer

x = Sheets.Count

For i = 1 To x - 1

	For j = i + 1 To x

    	If Sheets(j).Name < Sheets(i).Name Then

    	Sheets(j).Move before:=Sheets(i)

    	End If

	Next

Next

Sheets(1).Select

End Sub

                                        
      و لا تنسونا من صالح الدعاء

 

 

تم تعديل أكتوبر 24, 2016 بواسطه جلال الجمال_ابو أدهم