Çalışma Sayfasın'dan Belirli Hücreleri Hücre Biçimleri, Satır ve Sütun Genişlikleriyle Birlikte Başka Bir Sayfaya Kopyalama.

nsynsy · 16 Şubat 2020

Merhaba sevgili üstadlar.

"xyz" Sayfasında bulunan A8:AH46 aralığındaki verileri Nesneleri, Hücre Biçimleri, Hücre Biçimlendirme Kuralları, Satır ve Sütun Genişlikleriyle Birlikte Başka Bir Sayfaya Kopyalama ve Sayfa ismini'de A2 Hucresinden almasını istiyorum. Bu işlem aynı Excel Çalışma kitabında birden fazla yapılacağı için bunu bir butona bağlamak istiyorum. Yardımcı olabilirmisiniz. Şimdiden Teşekkürler.

genesis_vision · 16 Şubat 2020

Deneyiniz.

Kod:

Option Explicit
Sub SayfaEkle()
Dim ad As String
Dim sht As Worksheet

ad = Sheets("xyz").Range("a2").Value
For Each sht In ActiveWorkbook.Sheets
    If sht.Name = ad Then
        MsgBox "Bu isme sahip bir sayfa mevcuttur"
        Exit Sub
    End If
Next

Sheets("xyz").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
    .Name = ad
    .Shapes("CommandButton1").Delete
    .[a2].ClearContents
End With
Sheets("xyz").Select
End Sub

nsynsy · 17 Şubat 2020

Sevgili @genesis_vision bu kod ile yeni sayfa mevcut sayfamın tamamını kopyalamakta , benim isteğim A8:AH46 arasını kopyalaması aynı zamanda yeni açılacak sayfa adını da A2'den alması gerekli bu konuda yardımcı olurmusunuz.?

genesis_vision · 17 Şubat 2020

nsynsy' Alıntı:
Sevgili @genesis_vision bu kod ile yeni sayfa mevcut sayfamın tamamını kopyalamakta , benim isteğim A8:AH46 arasını kopyalaması aynı zamanda yeni açılacak sayfa adını da A2'den alması gerekli bu konuda yardımcı olurmusunuz.?

Örnek bir sayfa gönderirseniz daha kolay olur

genesis_vision · 17 Şubat 2020

nsynsy' Alıntı:
Sevgili @genesis_vision bu kod ile yeni sayfa mevcut sayfamın tamamını kopyalamakta , benim isteğim A8:AH46 arasını kopyalaması aynı zamanda yeni açılacak sayfa adını da A2'den alması gerekli bu konuda yardımcı olurmusunuz.?

Bu kodu deneyiniz.

Kod:

Option Explicit
Sub SayfaEkle()
Dim ad As String
Dim sht As Worksheet

ad = Sheets("xyz").Range("a2").Value
For Each sht In ActiveWorkbook.Sheets
    If sht.Name = ad Then
        MsgBox "Bu isme sahip bir sayfa mevcuttur"
        Exit Sub
    End If
Next

Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = ad
Sheets("xyz").Range("A8:AH46").Copy
Sheets(ad).Range("A8:AH46").PasteSpecial Paste:=xlPasteColumnWidths
Sheets(ad).[A8].PasteSpecial Paste:=xlPasteAll
Sheets("xyz").Select
End Sub

nsynsy · 17 Şubat 2020

@genesis_vision elleriniz dert görmesin Harika. Tek eksik sayfa satır yüksekliklerini ve a8:ah46 aralığında bulunan 4 adet resim bunlarıda yeni sayfaya aktarırsa bunun için hangi kodları da ekleme yapmalıyız?

genesis_vision · 17 Şubat 2020

nsynsy' Alıntı:
@genesis_vision elleriniz dert görmesin Harika. Tek eksik sayfa satır yüksekliklerini ve a8:ah46 aralığında bulunan 4 adet resim bunlarıda yeni sayfaya aktarırsa bunun için hangi kodları da ekleme yapmalıyız?

İlk çalışmamda sayfayı kopyalamamın sebebi tam da buydu. Sayfa kopyaladığımızda içerisinde bulunan tüm özellikleriyle birlikte kopyalar. Genişlikle, yükseklikle stillerle uğraşmazsınız. Sayfayı kopyalayıp gereksiz yerleri temizlersek daha kolay bir sonuç elde ederiz. Siz en iyisi "xyz" sayfasındaki gereksiz yerleri silip buraya yükleyin. Sayfayı görmeden işlem yapamam.