Alfabetik Sayfa Sıralam ve Yeni Bir sayfayı En En başa oluşturma Makro

[u.L.a.s]

Merhaba

Aşağıda çalışma kitabında olan sheet leri alfabetik sıraya göre sıralayan bir makro kod ve Yeni bir sayfa oluşturma kodu mevcut.

2 tane sorum olacak bu sorular için bilgi ve yardımlarınızı rica ederim

1. Sorum ben şu makro kod ile workbook en son a bir sheet oluşturuyorum. Bu yeni sayfa oluşturmayı en başa yaptırmak için kodda ne gibi bir düzenleme yapmak gerekir

Sheets.Add After:=Worksheets(Worksheets.Count)

2. Sorum ise alfabetik sıralama yapılan aşağıdaki kod düzeneğine göre belirlediğim sheetleri sıralamaya sokmayacak diğerlerini alfabetik sıraya göre dizecek bir kod lazım. yani Elimde 4 tane sayfa başta kalmalı
"Veri Girişi" "Mesailer" "Bordro" "Avanslar" adına sahip 4 sayfam bu alfabetik sıralam içerisinde yer almasın en başta olduğu gibi kalsın diğer sheetleri alfabetik sıralasın istiyorum

Sub sayfasirala()
Application.ScreenUpdating = False
Sheets.Add
ActiveSheet.Move After:=Sheets(Sheets.Count)
Set s1 = Sheets(Sheets.Count)
For a = 1 To Sheets.Count - 1
s1.Cells(a, "a") = Sheets(a).Name
s1.[a:a].Sort Key1:=s1.[A1]
deg = Sheets(a).Name
If IsNumeric(deg) = True Then deg = Val(Sheets(a).Name)
say = WorksheetFunction.Match(deg, s1.[a:a], 0)
Sheets(a).Move Before:=Sheets(say)
Next
Application.DisplayAlerts = False
s1.Delete
End Sub

 

[programer]

1 Sounuz için

Worksheets.Add Before:=Worksheets(1)

 

[programer]

2 Sorunuz için

Sub sayfasirala()
Application.ScreenUpdating = False
Sheets.Add
ActiveSheet.Move After:=Sheets(Sheets.Count)
Set s1 = Sheets(Sheets.Count)
For a = 1 To Sheets.Count - 1
if Sheets(a).Name <> "Veri Girişi" or Sheets(a).Name <> "Mesailer" or Sheets(a).Name <> "Bordro" or Sheets(a).Name <> "Avanslar" then
s1.Cells(a, "a") = Sheets(a).Name
s1.[a:a].Sort Key1:=s1.[A1]
deg = Sheets(a).Name
If IsNumeric(deg) = True Then deg = Val(Sheets(a).Name)
say = WorksheetFunction.Match(deg, s1.[a:a], 0)
Sheets(a).Move Before:=Sheets(say)
end if
Next
Application.DisplayAlerts = False
s1.Delete
End Sub

 

[u.L.a.s]

2. soru tamam eklediğiniz kodla sorunsuz çalışıyor.

ama 1. sorumda yine en sona sayfa oluşturuyor. bu yeni sayfa oluşturmaya ait aslında tüm makro kodum aşağıda acaba bu toplu kod içerisindede yapılması gereken bir şey varmıdır yeni oluşan sayfayı en başa oluşturması için diye gönderiyorum

Sub sayfa_aç()
    Dim sayfa As String
                  sayfa = syf
               If Not varmi(sayfa) Then
                   Sheets.Add After:=Worksheets(Worksheets.Count)
                   ActiveSheet.Name = syf
Set s1 = Sheets(sayfa)
Sheets("formatsayfa").Cells.Copy s1.Range("A1")
  s1.Range("A1") = syf
               End If
End Sub

 

[programer]

Sub sayfa_aç()
    Dim sayfa As String
                  sayfa = syf
               If Not varmi(sayfa) Then
                   Worksheets.Add Before:=Worksheets(1)
                   ActiveSheet.Name = syf
Set s1 = Sheets(sayfa)
Sheets("formatsayfa").Cells.Copy s1.Range("A1")
  s1.Range("A1") = syf
               End If
End Sub

 

[u.L.a.s]

Teşekkürler hocam emeğine bilgine sağlık