For Each SecilenSh In ActiveWindow.SelectedSheets değerlerini diziye almak

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
         secsfsay = ActiveWindow.SelectedSheets.Count
        For Each SecilenSh In ActiveWindow.SelectedSheets
            'msj = SecilenSh.Index & vbCrLf & msj
            SecilenSh.Copy   '*Seçili sayfayı yeni kitapa kopyala
        Next
satırı ile sırası gelen her sayfayı yeni kitaba kopyalıyor.

makro ile kaydettiğim kadarı ile hepsini aynı kitaba kopyalması için aşağıadaki gibi dizide olması lazım

Kod:
Sub Makro1()
    Sheets(Array("Sayfa2", "Sayfa3", "Sayfa4")).Select 
    Sheets("Sayfa4").Activate 
    Sheets(Array("Sayfa2", "Sayfa3", "Sayfa4")).Copy
End Sub
şeklinde diziye almak lazım ama nasıl
 
Son düzenleme:
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
yorumu olan hocamız yok mu acaba?
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Merhabalar

Aşağıdaki kod, seçili olan sayfaları, bir array'a atıp, hepsini birlikte yeni bir kitaba kopyalar

Kod:
Sub Toplu_Sheet_Kopyala()
Dim sh As Worksheet
Dim i%, y%
Dim arrsh()
For Each sh In ActiveWindow.SelectedSheets
    ReDim Preserve arrsh(y)
    arrsh(y) = sh.Name
    y = y + 1
Next
Sheets(arrsh).Copy
End Sub
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
teşekkür ederim hocam çok işime yarayacak evde deneyecem....
Amacım şu bir çalışma kitabım var o kitap korumalı ve doğal oalarak sayfalar silinemiyor, taşınamıyor, yeniden adlandırlamıyor ancak ben o kitaptan sayfa kopyalamaya ve sayfa eklemeye izin veriyorum.............
daha evvelden yapmıştım ama seçili ilk çalışma sayfasını kopyalayıp diğerlerini kopyalamıyordu.... sayenizde oda olacak gerçi kullandığım kodların yarısını siz yazdınız ben kendime uyarladım.. yani siz mühendis ben mütaahhit gibi olduk.

Emekleriniz için tekrar teşekkür ederim
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Private Sub CommandButton2_Click()                  '*Commonbutıon 2 ye tıklandığında
Dim i%, y%

    For Each sh In ActiveWindow.SelectedSheets          'seçili sayfaları sh değiknine al
        ReDim Preserve arrSh(y)                         'arrSh değişken dizisini boyutlandır
        arrSh(y) = sh.Name                              'seçili sayfaları arrSh değişken dizisine ver
        y = y + 1                                       'y yi 1 artır
    Next                                                'seçili sayfalar bitene kadar devam et


    If ComboBox1.Value = "(Yeni Kitap)" Then                '*Combobox1 yeni kitap ise
        Sheets(arrSh).Copy                                  '*Diziyi Yeni kitaba kopyala
        Call ComboBox1_Guncelle                             '*Combobox Güncelle (eklenen yeni kitabıda combobxta gör)
    ElseIf ComboBox1.Value = "(Yeni Kitaplara)" Then        '*Combobox1 yeni kitaplara ise
        For Each SecilenSh In ActiveWindow.SelectedSheets
            SecilenSh.Copy                                  '*Seçili sayfayı yeni kitapa kopyala
        Next
        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(arrSh).Copy After:=SecilenWkb.Sheets(ListBox1.ListIndex + 1)
        'Sheets(SecilenSh.Index).Copy After:=SecilenWkb.Sheets(ListBox1.ListIndex + 1)
        Call ListBox1_Guncelle                      '*Yeni sayfalarıda listboxta gör
    End If
Set arrSh() = Nothing
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
güzel oldu hocam
ReDim Preserve arrSh(y) 'arrSh değişken dizisini boyutlandır
umarım bu açıklamam doğrudur ben öyle algıladım.
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
ReDim Preserve arrSh(y) 'arrSh değişken dizisini boyutlandır umarım bu açıklamam doğrudur ben öyle algıladım
Doğrudur . Ancak, sadece Redim ifadesini kullanmak da dizileri boyutlandırır.

Preserve parametresinin kullanım sebebi, ise diziye atılmış eski verileri korumaktır.

Redim arrSh(y) demiş olsaydık, döngünün ilk adımlarında yüklenen sayfa adları, döngünü diğer adımlarında silinecekti. Preserve ile, arrSh'yi tekrar boyutlandırırken, eski veriler aynen kalmaktadır.

Yani Redim Preserve arrSh(2) dediğimizde, örneğin;
Arrsh(0) ->Sayfa1
ArrSh(1) ->Sayfa2
ArrSh(2) ->Sayfa3 değerlerini saklamakla beraber,

Redim arrSh(2) dediğimizde;
ArrSh(0) ->""
ArrSh(1) ->""
ArrSh(2) ->Sayfa3 dizi atamaları gerçekleşir
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
hocam açıklmalarınız için teşekkür ederim.
 
Üst