Seçili çalışma sayfalarının index no/nolarını tesbit etme

[hsayar]

Seçili çalışma sayfalarının index no/nolarını tesbit etme

Sub AktSayfaKopyala()
Sifreac
Sheets(ActiveSheet.Index).Copy After:=Sheets(ThisWorkbook.Sheets.Count)
Sifrekapa
End Sub

kodlar ile oluşturmuş olduğum menüden aktif sayfayı çalışma kitabının son sayfasından sonrasına kopyalıyorum

Ancak;
1) 1 veya daha fazla sayfa seçilince ekranda gözüken sayfayı kopyalıyor........
2) Yeni bir menü eklesem ve o menüden
seçili sayfayı kopyalamak için o an açık çalışam kitapları ve yeni kitap seçeneği sunsa mümkünmüdür.

bunlar zaten normalde oluyor ancak çalışma kitabımdan silme yeniden adlandırma ve taşıma işlemlerinin olmasını istemiyorum herhalde bu tekbaşına imkansız ki Çalışma kitabımı korumam yönünde tevsiye bulundu Sayın Leventm.

Bende düşününce kopyalama işlemine şifre aç ile izin verilebildiğine göre buda makro ile mümkün
yardımınıza müracaat ediyorum.
saygılarımla

 

[Orion1]

Ekli dosyayı inceleyiniz.

 

[hsayar]

Hocam örneğinizi ben menü ile yapıyorum... örneğe bakınız

istediğim korumalı olmayan bir çalışma sayfası açın birden fazla çalışma sayfasının seçin ve kopyala deyin.... istdiğiniz sayfaadları xxxx(2) şeklinde kopyalanır....

bizim yatığımız tek sayfa kopyalanması

 

[hsayar]

seçili çalışma sayfalarının indeks nolarını tesbit etmek imkansızmı acaba?

 

[hsayar]

çözümsüz herhalde? eğer öylr ise imkansız deyiniz lütfen

 

[Orion1]

seçili çalışma sayfalarının indeks nolarını tesbit etmek imkansızmı acaba?

Aşağıdaki kodu deneyiniz.

Sub indeks()
MsgBox ActiveSheet.Index
End Sub

 

[Ferhat Pazarçevirdi]

seçili çalışma sayfalarının indeks nolarını tesbit etmek imkansızmı acaba?

Merhabalar

Aşağıdaki kodla, çalışma kitabındaki, seçili sayfaları listeleyebilirsiniz.

Sub Secili_Olan_Sayfalar()
Dim SeciliSayfa As Worksheet
Dim msj As String
For Each SeciliSayfa In ActiveWorkbook.Windows.Item(1).SelectedSheets
[COLOR=green]'veya For Each SecilenSayfa In ActiveWindow.SelectedSheets[/COLOR]
    msj = SeciliSayfa.Name & vbCrLf & msj
Next
MsgBox msj
End Sub

 

[hsayar]

teşekkür ederim hocam

 

[hsayar]

Hocam kodları gördük maa rahatsızdım bakamadım benim kodlarım şu şekilde

Private Sub CommandButton2_Click()                  '*Commonbutıon 2 ye tıklandığında
Dim SecilenWkb As Workbook                          '*Değişken tanımla
Dim SecilenSh As Worksheet                          '*Değişken tanımla
'Set SecilenSh = ActiveSheet                         '*Değişkene değer ata
Dim msj As String

    If ComboBox1.Value = "(Yeni Kitap)" Then        '*Combobox1 yeni kitap ise
        For Each SecilenSh In ActiveWindow.SelectedSheets
            msj = SecilenSh.Index & vbCrLf & msj

[color="Red"]            'Sheets(SecilenSh.Index).Copy                '*Seçili sayfayı yeni kitapa kopyala [/color]
[B]'yukarıdaki satır birden fazla sayfa seçili ise hata veriyor. nasıl aşabilirim.?[/B]
        Next
MsgBox msj
        Call ComboBox1_Guncelle                     '*Combobox Güncelle (eklenen yeni kitabıda combobxta gör)
    Else                                            '*Değilse
        Set SecilenWkb = Workbooks(ComboBox1.Value) '*Değişkene değer ata
        '*Seçili sayfayı comboboxta seçili kitabın listboxta seçili sayfasından sonrasına kopyala
        Sheets(SecilenSh.Index).Copy After:=SecilenWkb.Sheets(ListBox1.ListIndex + 1)
        Call ListBox1_Guncelle                      '*Yeni sayfalarıda listboxta gör
    End If
Set SecilenWkb = Nothing            '*Değişkenleri boşalt
Set SecilenSh = Nothing             '*Değişkenleri boşalt
Unload Me                          '*Formu Kapat, Kapatmazsan sonsuz olarak kopyalamaya devam edebilirsin.
End Sub

'kımızı satır birden fazla sayfa seçili ise hata veriyor. nasıl aşabilirim.?