Şablon sayfadan diğer sayfalara makroyla nasıl aktarılır

[assenucler]

Değerli üstadlar;


Aşağıdaki dosyanın "Haneler Sablonu" sayfasında Hane No ve Kullanan sütunlarındaki bilgiler "sabit"; AyNo, islem ve Tutar sütunlarındaki bilgiler ise ay içinde toplanan paranın niteliği ve tutarına göre "değişken" lik göstermektedir.

Resimde de anlatmaya çalıştığım gibi, "Haneler Sablonu" sayfasında "AKTAR" makro düğmesine tıkladığımda, buradaki verilen "Aidat, Yakıt, Demirbaş, Alacak Tahsili ve Gecikme Tazminatı"sayfalarına aktarılması, konusunda değerli yardımınızı rica edeceğim.

Yardım ve katkılarınız için önceden teşekkürler.

Sevgi ve saygılar.

 

[asi_kral]

Merhaba
Haneler Şablon Sayfasında bir ayda iki kere aynı isim geçecek mi_?
Her ay alt alta mı işlenecek_?

 

[assenucler]

Haneler Şablon sayfasında "Hane No" ve "Kullanan" isimleri her ay sabit, diğer sütunlardaki Ay No, islem ve Tutar sütunlarındaki veriler ise her ay değişkendir.


Örneğin, Mayıs ayında yapılan tahsilat
Ay No - islem - Tutar
5, Aidat, 75,00
5, Yakıt, 100,00
5, Demirbaş, 40,00

her ay sonu ayrı ayrı "Hane Sablonu" sayfasına girilecektir ve bu sayfadaki "Hane No" ve "Kullanıcı" adları alt alta yazılı olacak.

"Hane Sablonu" sayfasına 5, Aidat, 75,00 TL. yazdıktan sonra "Aktar" düğmesine tıklanınca, "Aidat" sayfasının 5 nolu Ay No sütununa 75,00 TL.;

"Hane Sablonu" sayfasına 5, Yakıt, 100,00 TL. yazıp "Aktar" düğmesine tıklanınca, "Yakıt" sayfasının 5 nolu Ay No sütununa 100,00 TL;

"Hane Sablonu" sayfasına 5, Demirbaş, 40,00 TL yazıp "Aktar" düğmesine tıklanınca, "Demirbaş" sayfasının 5 Nolu Ay No sütununa 40,00 TL. alt alta yazılacak.

 

[asi_kral]

Haneler Şablon sayfasında "Hane No" ve "Kullanan" isimleri her ay sabit, diğer sütunlardaki Ay No, islem ve Tutar sütunlarındaki veriler ise her ay değişkendir.


Örneğin, Mayıs ayında yapılan tahsilat
Ay No - islem - Tutar
5, Aidat, 75,00
5, Yakıt, 100,00
5, Demirbaş, 40,00

her ay sonu ayrı ayrı "Hane Sablonu" sayfasına girilecektir ve bu sayfadaki "Hane No" ve "Kullanıcı" adları alt alta yazılı olacak.

"Hane Sablonu" sayfasına 5, Aidat, 75,00 TL. yazdıktan sonra "Aktar" düğmesine tıklanınca, "Aidat" sayfasının 5 nolu Ay No sütununa 75,00 TL.;

"Hane Sablonu" sayfasına 5, Yakıt, 100,00 TL. yazıp "Aktar" düğmesine tıklanınca, "Yakıt" sayfasının 5 nolu Ay No sütununa 100,00 TL;

"Hane Sablonu" sayfasına 5, Demirbaş, 40,00 TL yazıp "Aktar" düğmesine tıklanınca, "Demirbaş" sayfasının 5 Nolu Ay No sütununa 40,00 TL. alt alta yazılacak.

Merhaba
Kusura Bakmayın işler biraz yoğun cevap veremedim.
Kitabınızın kod bölümünde bulunan Thisworkbook bölümüne

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Konu       :   Sayfa Bilgilerini Aktar
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
If ActiveSheet.Name = "Haneler Sablon" Then Exit Sub
Dim s1 As Worksheet, s2 As Worksheet
Dim asi As Long, kral As Long, yıldız As Long
Set s1 = Sheets("Haneler Sablon")
Set s2 = ActiveSheet
Application.ScreenUpdating = False
s2.Range("C7:N65").ClearContents
yıldız = s1.Range("A" & Rows.Count).End(xlUp).Row
For asi = 7 To s2.Cells(Rows.Count, "A").End(xlUp).Row
For kral = 3 To s2.Cells(6, Columns.Count).End(xlToLeft).Column
s1.Range("A6:E" & yıldız).AutoFilter field:=2, Criteria1:=s2.Cells(asi, "B")
s1.Range("A6:E" & yıldız).AutoFilter field:=3, Criteria1:=s2.Cells(6, kral)
s1.Range("A6:E" & yıldız).AutoFilter field:=4, Criteria1:=s2.Name
s2.Cells(asi, kral) = WorksheetFunction.Subtotal(9, s1.Range("E6:E" & yıldız))
s1.Range("A6:E" & yıldız).AutoFilter
Next: Next
Application.ScreenUpdating = True
MsgBox s2.Name & " Verilerini Aktardım" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Bu kodu kopyalayın ve deneyin.
Sayfa aktif olduğunda verileri aktarır.
Dosyanız Ekte.

 

[Murat OSMA]

Alternatif:

Sub Emre()
    Dim syf As Worksheet
    Dim i As Integer, a As Integer
        For Each syf In Worksheets
            With Sayfa1
                For i = 7 To .Range("A65536").End(3).Row
                    For a = 3 To 14
                        If .Cells(i, "D") = syf.Name And .Cells(i, "C") = syf.Cells(6, a) Then
                            .Cells(i, "E").Copy syf.Cells(i, a)
                        End If
                    Next a
                Next i
            End With
        Next syf
    a = Empty: i = Empty: Set syf = Nothing
End Sub

 

[assenucler]

Teşekkürler

Sayın asi Kral 1967;

Günaydın ve hayırlı işler.

Kusur ne demek, rica ederim. İlginiz ve emek vererek hazırladığınız çözüm kodları için size teşekkürler. Her şey gönlünüzün güzelliği gibi olsun.

Sevgi ve saygılar.



Sayın Murat Osma;

Üstadım, sizler bizlerin gönül dostusunuz... Allah sizlerden razı olsun...

Sevgi ve saygılar.

 

[asi_kral]

Sayın asi Kral 1967;

Günaydın ve hayırlı işler.

Kusur ne demek, rica ederim. İlginiz ve emek vererek hazırladığınız çözüm kodları için size teşekkürler. Her şey gönlünüzün güzelliği gibi olsun.

Sevgi ve saygılar.



Sayın Murat Osma;

Üstadım, sizler bizlerin gönül dostusunuz... Allah sizlerden razı olsun...

Sevgi ve saygılar.

Kolay Gelsin.