Varolan Çalışma kitabını Yeni isimle kaydetmek

[gamisaga]

sayfa kopyalama sorunu

Selam iyi çalışmalar,
Forumda yaptığım aramalarda tam istediğim örneğe ulaşamadım. Lakin bazı dosyalarda konu eski olduğu için ataçları çalışmamaktadır.

Şöyle bir sıkıntım var.

Deneme.Xls Çalışma kitabımda 6 adet sayfa mevcut "Sayfa1(işlem), Sayfa2(Basketbol), Sayfa3(Tenis), Sayfa4(Voleybol), Sayfa5(Yüzme), Sayfa6(futbol)" isimlerinde.

Sayfa1 de eklenmiş olan bir butona tıklandığında "C:\deneme1.xls" adında Sayfa2 den başlamak suretiyle sayfa6 dahil sonuna kadar yeni bir dosya oluşturmak ?

Yani oluşacak yeni dosyam Deneme1.xls dosyam Deneme.xls deki verileri içererek "Sayfa1" hariç Sayfa2(Basketbol), Sayfa3(Tenis), Sayfa4(Voleybol), Sayfa5(Yüzme), Sayfa6(futbol) şeklinde olacak ? bunu nasıl yapabilirim ?

 

[gamisaga]

Sub Kopyalama()
Dim kopyaal As String, kopyayolla As String, dosyam As String

    strdate = Format(Now, "dd.mm.yyyy")
    dosyam = ActiveWorkbook.Name
    kopyaal = ThisWorkbook.FullName
    kopyayolla = "d:\" & strdate & ".xls"
    ThisWorkbook.SaveCopyAs kopyayolla
        kopyaal = vbNullString
            dosyam = vbNullString
                kopyayolla = vbNullString
End Sub

bu kod ile varolan dosyayı istediğim yere gunun tarihi ile kaydete biliyorum ama ben kopyalacak çalışma kitabımdaki sayfalardan işlemler sayfam hariç kopya oluşturmak istiyorum.

 

[gamisaga]

yardım

Yardım edebilecek kimse yok mu?

 

[gamisaga]

konu güncel yardımcı olabilecek müsait zamanı olan hocalarım varsa sevinirim.

 

[halit3]

Bunu denermisiniz.

Sub deneme()
Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To Sheets.Count
r = 0
If Sheets(i).Name <> "İşlem" Then
r = 1
End If
If r = 1 Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
Sheets(myArray).Copy
ActiveWorkbook.Sheets(Sheets(1).Name).Select
ActiveWorkbook.SaveAs "c:\deneme.xls"
ActiveWorkbook.Close SaveChanges:=False
End Sub

 

[gamisaga]

Teşekkür Ederim

Halit Bey yardımlarınız. İçin Teşekkür Ederim. Vermiş olduğunuz Kod istediğim işi birebir yapmaktadır. Bundan sonraki yardım isteklerimde ise

Sorularınız sorarken örnek dosya ile destekleyiniz ve kısa açıklama yaparak yazınız. Dosyanın içine yapılacak açıklama herkesin bu dosyayı indirmesi gerektiğinden kotalar gereksiz yere dolmaktadır. Bu yüzden sorularınıza cevap verebilmemiz için kısa açıklamanızı mutlaka yapınız. Örnek dosyanız bire bir aynı, kısa boyutlu ve şifresiz olmasına özen gösteriniz. Soru sorduğunuzda cevaplayan kişilere ait olumlu veya olumsuz mutlaka geri dönüş yapınız.

dikkate alacağım.

 

[halit3]

Halit Bey yardımlarınız. İçin Teşekkür Ederim. Vermiş olduğunuz Kod istediğim işi birebir yapmaktadır. Bundan sonraki yardım isteklerimde ise
dikkate alacağım.

iyi çalışmalar