Tabloyu otomatik getirme

[okur00000]

merhabalar,
1.çalışma sayfasındaki tabloyu hazır bir şekilde 2.çalışma sayfasındaki a14 hücresine getirmek istiyorum. Bunu istememdeki sebep elimde böyle yüzlerce tablo olacak ve her seferinde kopyala yapıştır mantığıyla gitmek istemiyorum yardımcı olabilecek arkadaşlara şimdiden teşekkür ediyorum.

 

[Muzaffer Ali]

Merhaba.

Sayfa 1'in kod kısmına kopyalayıp çalıştırınız.

Sub Kopyala()
    Dim Say As Long
    With Worksheets("2")
        Say = .Cells(Rows.Count, "B").End(xlUp).Row
        Range("A1:L" & Cells(Rows.Count, "L").End(xlUp).Row).Copy _
            (.Range("A" & Say + 2))
        With .Range("A" & Say + 1 & ":O" & Say + 1).Interior
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = -0.499984740745262
        End With
        Kenarlik .Range("M" & Say + 1 & ":O" & .Cells(Rows.Count, "B").End(xlUp).Row)
    End With
    
End Sub

Sub Kenarlik(alan As Range)
    alan.Borders(xlDiagonalDown).LineStyle = xlNone
    alan.Borders(xlDiagonalUp).LineStyle = xlNone
    With alan.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With alan.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With alan.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With alan.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With alan.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With alan.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

 

[okur00000]

Hocam öncelikle ellerinize sağlık gayet güzel çalışıyor fakat ben size tablonun fonksiyonsuz halini göndermişim rica etsem bunun içinde gerekli kodları gösterebilir misiniz ? Hocam bir sorum daha olacak kodlar mevcut haliyle 2. çalışma sayfasına ekleme yapıyor 3. 4. 5. çalışma sayfalarına ekleme yapmak istediğim zaman hangi adımları izlemem gerekecek ?

 

[Necdet]

Merhaba,
Ben de üzerinde çalışmıştım.
Sanki soru eksik gibi geldi bana. Ben de kendimce düzenleyerek kodları yazdım.

1. sayfa olarak adlandırılan sayfada A1 hücresinin Biçimini

0". HAFTA"

olarak değiştirdim ve sadece rakam yazıldığında ". HAFTA" görünümü oluşacaktır.

Yine sayfa1 deki hafta ve tarihler güncellenerek sayfa2 ye aktarımı sağlanmıştır.

Sayfa adları ve VBA daki Sayfa İndisleri düzenlenmiştir. Kodların daha sade olması için Sayfa indisi kullanılmıştır.

Sub Kopyala()

Dim i   As Long

Sayfa1.Range("A1") = Sayfa1.Range("A1") + 1
i = Sayfa1.Cells(Rows.Count, "B").End(3).Row
Sayfa1.Range("B1") = Sayfa1.Range("B" & i) + 3
Sayfa1.Range("B1:B" & i).DataSeries Date:=xlDay

i = Sayfa2.Cells(Rows.Count, "B").End(3).Row + 2
Sayfa1.Range("A1").CurrentRegion.Copy Sayfa2.Range("A" & i)

End Sub

 

[okur00000]

Teşekkürler Necdet bey, tarihlerin otomatik değişmesi gayet başarılı olmuş ellerinize sağlık fakat ilk dosyayı eksik göndermişim. Doğru olan dosyaya uyarlamasını bir türlü yapamadım.

 

[Necdet]

Merhaba,
Benim gönderdiğim dosya üzerinden gidin, ya da sizin dosyanızı benim gönderdiğim dosya gibi değiştirin