liste ile seçilen sekme adlarını değiştirme

[modoste]

merhaba sayın hocalarım
dosyamda
sayfa1-sayfa2-sayfa3-1-2-3... diye sekmelerim var
"makro" adlı yeni sekme açıcam B1:B10 arasına değiştirmeyi istediğim sekmeleri yazacam, C1:C10 arasına da değişecek sekmelerin yeni adlarını yazacam.
makro çalıştığında sekmeler yeni adlarını alacak

 

[yanginci34]

Örneği incelermisiniz.

 

[modoste]

veyselemre nin çözümünü koda yazdım
ama hata aldım. ekli tablo veyselemre çözümü için

run time error 1004 hatası verdikten sonra çözüm yapıyo sayın yanginci34 ün dosyası

 

[yanginci34]

Benim örnek dosyamda değiştirmek istediğiniz sayfa isimlerini a sütununa yazıyoruz b sütununda boş hücre bululnursa hata verir çünkü sekmenin yeni ismi b sütununa yazıldığı için ve sekme ismi boş bırakılamayacağından kod doğal olarak hata verir

 

[yanginci34]

Peki bunu denermisiniz

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Sayfa_Isimlerini_Degistir()
    Dim Veri As Range, S1 As Worksheet, S2 As Worksheet, Say As Integer, Benzer_Say As Integer
   
    With Sheets("makro")
        For Each Veri In .Range("B1:B" & .Cells(.Rows.Count, 2).End(3).Row)
            If Veri.Value <> "" Then
                On Error Resume Next
                Set S1 = Nothing
                Set S1 = Sheets(CStr(Left(Veri.Value, 31)))
                If Not S1 Is Nothing Then
                    Set S2 = Nothing
                    Set S2 = Sheets(CStr(Left(Veri.Offset(, 1).Value, 31)))
                    On Error GoTo 0
                    If S2 Is Nothing Then
                        If Not IsEmpty(Veri.Offset(, 1).Value) Then
                            S1.Name = Left(Veri.Offset(, 1).Value, 31)
                            Say = Say + 1
                        End If
                    Else
                        Benzer_Say = Benzer_Say + 1
                    End If
                End If
            End If
        Next
    End With
   
    If Say = 0 Then
        MsgBox "İsmi değiştirilecek sayfa bulunamadı!" & vbCr & vbCr & _
               Benzer_Say & " adet sayfa adı aynı olan veri tespit edilmiştir!" & vbCr & _
               "Bu sayfalara işlem yapılmamıştır.", vbExclamation
    Else
        MsgBox Say & " adet sayfa ismi değiştirilmiştir." & vbCr & vbCr & _
               Benzer_Say & " adet sayfa adı aynı olan veri tespit edilmiştir!" & vbCr & _
               "Bu sayfalara işlem yapılmamıştır.", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[tacettinsal]

merhaba sayın hocalarım
dosyamda
sayfa1-sayfa2-sayfa3-1-2-3... diye sekmelerim var
"makro" adlı yeni sekme açıcam B1:B10 arasına değiştirmeyi istediğim sekmeleri yazacam, C1:C10 arasına da değişecek sekmelerin yeni adlarını yazacam.
makro çalıştığında sekmeler yeni adlarını alacak

deneyiniz. Henüz yeniyim hatalarım olursa affola.

Private Sub Worksheet_Activate()
For i = 1 To 10
Cells(i, 2) = Sheets(i).Name
Next i
End Sub
--------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row <= 10 And Target.Row >= 1 And Target.Column = 3 Then
    For j = 1 To 10
        If Cells(j, 3) <> 0 Then
        Sheets(j).Name = Cells(j, 3)
        Cells(j, 2) = Cells(j, 3)
        ElseIf Cells(j, 2) <> 0 Then
        Sheets(j).Name = Cells(j, 2)
        End If
    Next j
End If
End Sub

 

[modoste]

tüm yanıtları uyguladım korhan hocamında çözümünü denedim
çok teşekkür ederim.

 

[Korhan Ayhan]

Küçük hatırlatma;

Benim çözümümde ekstradan sayfa ismi sınırı aşan bir isim verirseniz ilk 31 karakterini baz alarak isimlendirme yapmaktadır.
Ayrıca benzer isim verirseniz bu konuda uyarıyor. Benzer ismi işleme almıyor.

Aslında bir de sayfa isminde olmaması gereken hatalı karakterler için kontrol eklemek gerekebilir.

 

[modoste]

bugün sabah sorduğum makrolu sorunun cevabı 1-2-3 sekme adlarıyla yanyana verilen bir yanıttı.
bu sorumlada yanyana1-2-3 dvam eden sekmelere istediğim adları verebilmekti.
çözüm üretildi gibi sayfa kenarlıkları ve biçimleri eksik bir çözümdü o sorumun çözümününde revize edilmesini beklemekteyim
korhan hocam ve diğer hocalarım bakabilirse sevinirim.