Diğer sayfalara aktarma

[pendik1970]

Kolay Gelsin.
Forumda arama yaptım ama bulamadım aradığıma cevap olacak çalışmayı."Genel" sayfasında işletmelere göre veriler var. Bu verilerin bulunduğu satırları işletmelere göre hazırlanan sayfalara aktarılmasını istiyorum. Yardımcı olabilirseniz çok sevinirim.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu kullanabilirsiniz.

Sub aktar()
Set gen = Sheets("GENEL")
For i = 2 To gen.[A65500].End(3).Row
    Set sayfa = Sheets("" & gen.Cells(i, 2) & "")
    son = sayfa.[A65500].End(3).Row + 1
    For j = 1 To 12
        sayfa.Cells(son, j) = gen.Cells(i, j)
    Next
Next
End Sub

 

[pendik1970]

İlgilendiğiniz için teşekkür ederim. Şu an hazır sayfaya kodu yapıştırınca diğer sayfalara dağılım oldu. Ancak ana sayfada değişiklik yapınca diğer sayfalara yansıması.

 

[ÖmerBey]

Aşağıdaki ilaveyi yapınız.

Sub aktar()
Set gen = Sheets("GENEL")

[COLOR="Red"]For Each sekme In Worksheets
    If sekme.Name <> gen.Name Then sekme.Range("A2:L65500").ClearContents
Next[/COLOR]
    
For i = 2 To gen.[A65500].End(3).Row
    Set sayfa = Sheets("" & gen.Cells(i, 2) & "")
    son = sayfa.[A65500].End(3).Row + 1
    For j = 1 To 12
        sayfa.Cells(son, j) = gen.Cells(i, j)
    Next
Next
MsgBox "Aktarım tamamlandı."
End Sub

 

[pendik1970]

Sayın mucit77, Genel sayfasında herhangi bir değişiklik yaptığımda macro kodunu açıp çalıştırmam gerekiyor. Her defasında böyle mi yapmam gerek. Yoksa genel sayfasında yaptığım değişiklik macroyu açmadan diğer sayfalara yansımaz mı?

 

[ÖmerBey]

Bu şekliyle her defasında makroyu çalıştırmanız gerek, ancak isterseniz değişiklik yapıldığı zaman da ayarlanabilir ancak her değişiklik yaptığınızda makro sıfırdan çalışacağı için sisteminizi yoracaktır.
Eğer her değişiklik yapıldığında makronun otomatik çalışmasını istiyorsanız. Makroyu genel sayfasının kod bölümüne worksheet_change koduyla kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
Set gen = Sheets("GENEL")

For Each sekme In Worksheets
    If sekme.Name <> gen.Name Then sekme.Range("A2:L65500").ClearContents
Next
    
For i = 2 To gen.[A65500].End(3).Row
    Set sayfa = Sheets("" & gen.Cells(i, 2) & "")
    son = sayfa.[A65500].End(3).Row + 1
    For j = 1 To 12
        sayfa.Cells(son, j) = gen.Cells(i, j)
    Next
Next
End Sub

 

[pendik1970]

Teşekkür ederim mucit77. Tam istediğim gibi oldu.