Sayfa yerlerinin değiştirilmesi konusunda yardım !

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Sayın Yusuf44 hocanın çalışmasından bir parçayı uyarlamaya çalıştım, başaramadım. Bir yerde hata yapıyorum sanırım. D sütunundakiler, dosya içindeki sayfaların şu anki durumunun listesi. İstenen ise A32 sütunundan sonraki hali. Bu bölüm manuel olarak değiştirilip makro çalıştığında dosyadaki sayfaların sırası değişsin.

Sub Sayfa_Sirala()
Son = [A29]
    For cari = 32 To Son
        For Sayfa = 1 To Sheets.Count - 1
            If Sheets(Sayfa).Name = Cells(cari, "A") Then
                Sheets(Sayfa).Move After:=Sheets(cari + 1)
            End If
        Next
    Next
End Sub

Ornek_TK

Saygılarımla

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kod ile yapabilirsiniz.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Dim AktifSayfa As Worksheet
    Set AktifSayfa = ActiveSheet
    Say = Cells(Rows.Count, "A").End(3).Row
    For Bak = 32 To Say
        Worksheets(Cells(Bak, "A").Text).Move after:=Worksheets(Bak - 31)
    Next
    AktifSayfa.Activate
End Sub

 

[Tevfik_Kursun]

Sayın Dalgalıkur Hocam,
İlginize teşekkür ederim. Resimdeki hatayı verdi.
Saygılarımla

 

[Muzaffer Ali]

Bir de aşağıdaki kodları deneyin.

Eğer hata verirse hata mesajını da söyleyin.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Dim AktifSayfa As Worksheet
    With ThisWorkbook
        Set AktifSayfa = .ActiveSheet
        Say = AktifSayfa.Cells(Rows.Count, "A").End(3).Row
        For Bak = 32 To Say
            If SayfaVarmi(AktifSayfa.Cells(Bak, "A").Text) Then
                .Worksheets(AktifSayfa.Cells(Bak, "A").Text).Move before:=.Worksheets(.Worksheets.Count)
            End If
        Next
    End With
    AktifSayfa.Activate
End Sub

Function SayfaVarmi(SayfaAdi As String) As Boolean
    Dim Bak As Worksheet
    For Each Bak In ThisWorkbook.Worksheets
        If Bak.Name = SayfaAdi Then
            SayfaVarmi = True
            Exit Function
        End If
    Next
    MsgBox "'" & SayfaAdi & "' adlı sayfa bulunamadı."
End Function

 

[Tevfik_Kursun]

Sayın Dalgalıkur Hocam,
İlginize çok teşekkür ederim. Beklediğim oldu. Tek sorun karışmaması gereken sayfaları sona atmış.
Yeri gelmişken bir soru sorayım. Açıp-okutup-geri kapatmanın dışında gizlenmis sütundakileri okumasının bir yolu var mı?
Saygılarımla

 

[Muzaffer Ali]

Taşınmaması gereken birden fazla sayfa olduğunu söylememiştiniz.

Yukarıdaki kodu değiştirdim şimdi tekrar deneyin.

Diğer sorunuzu anlamadım. Biraz açar mısınız?

 

[Tevfik_Kursun]

Merhaba Dalgalıkur Hocam,
end with ekledim
bir hata daha var, en sona yerleştirilen yeni oluşan sayfayı doğru yer listede olduğu halde yerine koyamıyor.
Saygılarımla

 

[Muzaffer Ali]

Ben şimdi örnek dosyaya bir sayfa ekledim sayfa ismini de A sütunundaki listeye yazdım, aynen yazdığım sıraya göre sayfaları sıraladı.

 

[Tevfik_Kursun]

O zaman benim yaptığımda hata var. İnceler misiniz, lütfen?
Saygılarımla

 

[Muzaffer Ali]

İlk örnekte sayfa isimleri 32. satırdan başlıyordu onun için kodda şöyle bir satır var; For Bak = 32 To Say buradaki 32 28 ile değiştirilmesi gerekir.

Sayfa isimlerinin başladığı satır değişkenlik göstermiyorsa kodlarda bulunan For Bak = 32 To Say satırını For Bak = 28 To Say yapmanız yeterli.

 

[Tevfik_Kursun]

Ben nümerik sayfaları A32 den başlatmıştım. Bu dediğiniz aklıma gelmedi. İlginize ve sabrınıza çok teşekkür ederim.
Saygılarımla

 

[Muzaffer Ali]

Rica ederim iyi çalışmalar.

 

[Tevfik_Kursun]

İyi çalışmalar arkadaşım
Saygılarımla