Sayfa1 deki Tabloyu Diğer sayfalara otomatik kopyalama MAKRO!

[Emiroğlu61]

Arkadaşlar 01.01.2023 tarihinden 31.12.2023 tarihine kadar sayfam var, 01.01.2023 deki tablomu tüm sayfalara kopyalaya bilecek bir formül rica ediyorum mümkünse Teşekkürler

 

[dEdE]

Bir modüle yapıştırarak dener misiniz?
Tablonuzun A1:F20 aralığında olduğunu varsaydım.

Sub Tablo_Kopyala()
    For i = 2 To Sheets.Count
        Sheets("01.01.2023").Range("A1:F20").Copy Sheets(i).Range("A1")
    Next
End Sub

 

[necati]

Merhaba,
Kitaptaki tüm sayfaların aynı bölgesine "SEÇİLEN VERİ"yi bir anda kopyalamak için örnek bir makro:
Önce tabloyu seçin sonra makroyu çalıştırın.

Sub SayfalarıDoldur2()
Worksheets.FillAcrossSheets Range:=Selection, Type:=xlAll
End Sub

 

[Emiroğlu61]

Bir modüle yapıştırarak dener misiniz?
Tablonuzun A1:F20 aralığında olduğunu varsaydım.

Sub Tablo_Kopyala()
    For i = 2 To Sheets.Count
        Sheets("01.01.2023").Range("A1:F20").Copy Sheets(i).Range("A1")
    Next
End Sub

A1:H42 arasında olarak değiştirdim, lakin makroyu çalıştırdığımda işe yaramıyor.

 

[Emiroğlu61]

Merhaba,
Kitaptaki tüm sayfaların aynı bölgesine "SEÇİLEN VERİ"yi bir anda kopyalamak için örnek bir makro:
Önce tabloyu seçin sonra makroyu çalıştırın.

Sub SayfalarıDoldur2()
Worksheets.FillAcrossSheets Range:=Selection, Type:=xlAll
End Sub

sizi yazdığınız kodu yeni bir excel sayfası açıp tablo oluşturduğumda yapıyor, lakin benim daha önceden makro kullanarak 01.01.2023 den 31.12.2023 e kadar açtığım sayfalara kopyalamıyor, sadece seçtiğim bölge diğer sayfalardada seçilmiş görünüyor. Anlayamadım.

 

[Emiroğlu61]

Sub SayfalarıDoldur2()
Worksheets.FillAcrossSheets Range:=Selection, Type:=xlAll
End Sub

Bu kodun mantığı sadece çizili yazılı tabloyu kopyalamak, benim kopyaladığım tabloyu seçtiğimde hiç birini maalesef alamıyor, ayrıca dolgu rengi eklediğimde de algılamıyor.

 

[dEdE]

A1:H42 arasında olarak değiştirdim, lakin makroyu çalıştırdığımda işe yaramıyor.

Dener misiniz?

 

[Emiroğlu61]

Dener misiniz?

ALTIN ÜYE DEĞİLİM MAALESEF İNDİREMİYORUM

 

[dEdE]

ALTIN ÜYE DEĞİLİM MAALESEF İNDİREMİYORUM

https://s6.dosya.tc/server11/0g6gju/Emiroglu61_.xlsm.html

 

[Emiroğlu61]

https://s6.dosya.tc/server11/0g6gju/Emiroglu61_.xlsm.html

Gönderdiniz excel dosyası işe yaradı çok teşekkürler emeğinize sağlık, lakin 1 sorunum daha Var, Satır Yüksekliği ve Satır Genişliği İlk sayfadaki gibi olmuyor, bunun bir çözümü varmıdır?

 

[dEdE]

Merhaba,
Gecikme için üzgünüm. Sorunuzu yeni fark ettim.
Aşağıdaki kod ile, tabloyu kopyalamak yerine sayfayı kopyalayıp çoğaltarak satır ve sütun genişlikleri sorununu aşabiliriz. Böylece sayfa eklemeyi de otomatik yaparız.
Kodun For Say = 2 To 364 satırındaki 364 sayısı eklenecek sayfa adedini gösterir. Bu sayıyı değiştirerek farklı adette sayfa ekleyebilirsiniz.

Sub Sayfa_Ekle()
Application.ScreenUpdating = False
ilk = CDate("01.01.2023")
    For Say = 2 To 364
        Worksheets("1.01.2023").Copy After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = DateAdd("d", Say - 1, ilk)
    Next
Application.ScreenUpdating = True
End Sub

 

[Emiroğlu61]

Merhaba,
Gecikme için üzgünüm. Sorunuzu yeni fark ettim.
Aşağıdaki kod ile, tabloyu kopyalamak yerine sayfayı kopyalayıp çoğaltarak satır ve sütun genişlikleri sorununu aşabiliriz. Böylece sayfa eklemeyi de otomatik yaparız.
Kodun For Say = 2 To 364 satırındaki 364 sayısı eklenecek sayfa adedini gösterir. Bu sayıyı değiştirerek farklı adette sayfa ekleyebilirsiniz.

Sub Sayfa_Ekle()
Application.ScreenUpdating = False
ilk = CDate("01.01.2023")
    For Say = 2 To 364
        Worksheets("1.01.2023").Copy After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = DateAdd("d", Say - 1, ilk)
    Next
Application.ScreenUpdating = True
End Sub

İşe yaradı emeğinize sağlık, son sorum "GH4" hücresine Sayfanın ismini kopyalamam gerekiyor. tüm sayfalar için.

 

[dEdE]

Aşağıdaki kodu kullanabilirsiniz.

Sub Sayfa_Ekle()
Application.ScreenUpdating = False
ilk = CDate("01.01.2023")
    For Say = 2 To 364
        Worksheets("1.01.2023").Copy After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = DateAdd("d", Say - 1, ilk)
        ActiveSheet.Range("GH4") = ActiveSheet.Name
    Next
Application.ScreenUpdating = True
End Sub