Sayfa isimlerini Hücreye Sıralama Makrosu..

[izomer]

Değerli Excel web ailesine selamlar, saygılar.

Ben sayfaları kontrol ederek B5 hücresinden aşağıya doğru sıralayan

bir makro butonu rica ediyorum. Örnek Ektedir.

Şimdiden çok teşekkürler.

 

[askm]

Aşağıdaki kodlar hem sayfaları sıralıyor hem de sayfa isimlerini yazıyor.

Sub Sayfa_Sirala()
Dim i, j, satir As Integer
satir = 5
For i = 2 To Sheets.Count
For j = 2 To Sheets.Count - 1
If UCase(Sheets(j).Name) > UCase(Sheets(j + 1).Name) Then    ' < şekilde olursa Z den A ya sıralar
    Sheets(j).Move after:=Sheets(j + 1)
End If
Next
Next

For i = 1 To Sheets.Count
If Sheets(i).Name <> "Anasayfa" Then
Sheets("Anasayfa").Cells(satir, 2) = Sheets(i).Name
satir = satir + 1
End If
Next
End Sub

 

[izomer]

saolun hocam çalışıyor ancak misal bi sayfayı sildiğimde ve butona tıkladığımda o sayfayı listeden silmiyor. o özelliğide olursa çok iyi olurdu..önce b5 hücresi ve altındakileri temizlesin sonra sıralasın çözümü bu sanırım ? .. zaten dosyanın içindeki açıklamada bu konuyu yazmıştım..

ayrıca ekstradan bir sorum daha olucak olabilirse yani ..misal anasayfa haricinde başka özel sayfalarında gösterilmemesini sağlamak için nasıl bir değişiklik yapılabilirim formülde veya anasayfa içinde bazı hücrelere görünmememesini istediğim sayfaların listesini yazıp formülde o alandaki sayfa isimlerini algılayıp listeleme dışı bırakabilirmi ?

 

[askm]

Birinci sorunuz kodun başına. Range("b5:b100").clearcontents yazın.
İkinci sorunuz.
If Sheets(i).Name <> "Anasayfa" or Sheets(i).Name <> "Anasayfam1" Then gibi yazın.

 

[izomer]

Birinci sorunuz kodun başına. Range("b5:b100").clearcontents yazın.
İkinci sorunuz.
If Sheets(i).Name <> "Anasayfa" or Sheets(i).Name <> "Anasayfam1" Then gibi yazın.

Hocam temizleme olayı güzel çalıştı

Ama listelememe olayı çalışmadı

saklı1 ve saklı 2 diye sayfa oluşturdum ama yine listeledi..sadece anasayfalı ilk kod çalışıyor yani.

If Sheets(i).Name <> "Anasayfa" Or Sheets(i).Name <> "saklı1" Then

yaptım saklı 1 i yine listeledi..

birde başka bir çözüm varsa 2 den fazla sayfa olunca nasıl bir kod olur onuda yazarsanız süper olur hocam.

 

[Ömer BARAN]

Hocam temizleme olayı güzel çalıştı

Ama listelememe olayı çalışmadı

saklı1 ve saklı 2 diye sayfa oluşturdum ama yine listeledi..sadece anasayfalı ilk kod çalışıyor yani.

If Sheets(i).Name <> "Anasayfa" AND Sheets(i).Name <> "saklı1" Then

yaptım saklı 1 i yine listeledi..

birde başka bir çözüm varsa 2 den fazla sayfa olunca nasıl bir kod olur onuda yazarsanız süper olur hocam.

Merhaba.

Listelenmeyecek sayfa adları için OR bağlacı yerine AND bağlacı kullanırsanız istediğinizin olması lazım.

 

[izomer]

Merhaba.

Listelenmeyecek sayfa adları için OR bağlacı yerine AND bağlacı kullanırsanız istediğinizin olması lazım.

Aynen Hocam and bağlacıyla oluyor çok çok müteşekkirim hepinize. askm ve baran hocam saolun var olun..Sağlıcakla kalın.Excel webe herkesin destek olması için altın üyeliğe davet ediyorum..

Herkese faydalı olması için dosyayı eke koyuyorum.

 

[izomer]

Sayfa Sıralamada benim projede çok hızlı ve sorunsuz çalışan ve sıra sayılarınıda hesaplayan başka bir kod buldum ama bundada istenilen sayfayı listelememe özelliği yok istenilen sayfayı listelememe kodunu benim bulduğum makroya nasıl entegre edebilirim ?


Sub sırala()
For a = 1 To Sheets.Count
If WorksheetFunction.CountIf(Range("B5:B500"), Sheets(a).Name) = 0 Then
With Cells(Range("B65500").End(3).Row + 1, "B")
.Value = Sheets(a).Name
.Offset(0, -1).Value = "***"
End With
ElseIf WorksheetFunction.CountIf(Range("B5:B500"), Sheets(a).Name) = 1 Then
Range("B5:B500").Find(Sheets(a).Name).Offset(0, -1).Value = "***"
End If
Next
say = WorksheetFunction.CountIf(Range("A5:A500"), "***")
For b = Range("B65500").End(3).Row To 5 Step -1
If Cells(b, "A") <> "***" Then
Cells(b, "A").EntireRow.Delete
Else
Cells(b, "A") = say
say = say - 1
End If
Next
Range("B5:B500").Sort Key1:=Range("B5"), Order1:=xlAscending
End Sub

For i = 1 To Sheets.Count
If Sheets(i).Name <> "Anasayfa" Then
Sheets("Anasayfa").Cells(satir, 2) = Sheets(i).Name
satir = satir + 1


Entegre edilecek kod.
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Anasayfa" Then
Sheets("Anasayfa").Cells(satir, 2) = Sheets(i).Name
satir = satir + 1