• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Diğer sayfalara aktarma

Katılım
30 Ocak 2014
Mesajlar
18
Excel Vers. ve Dili
excel 2010 tr
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.
 

Ekli dosyalar

Merhaba,
Aşağıdaki kodu kullanabilirsiniz.
Kod:
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
 
İ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ı.
 
Aşağıdaki ilaveyi yapınız.
Kod:
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
 
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ı?
 
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.
Kod:
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
 
Son düzenleme:
Teşekkür ederim mucit77. Tam istediğim gibi oldu.
 
Geri
Üst