İki sayfa arası koşullu veri aktarımı

[kenangulal]

Arkadaşlar selam,
Verileri birleştirirken çözemediğim bir eşleştirme var.

1- "toplam" sayfasındaki kırmızı alanın karşısındaki "mavi " alana "veri" sayfasındaki "mavi" alandaki rakamları getirmek istiyorum.
2- bu transfer "sarı" alandaki değişkene göre ayarlanmalı yani veri sayfasında "sarı" alanda "1" yazıyorsa toplam alanında "1" yazan yerin altında bulunan mavi alana kopyalamalı "2" yazıyorsa "2"nin altındakine,
3- "veri" sayfasındaki kırmızı alanlar sabit değildir, yani 54 numara yukarı aşağı yer değiştirebilir.

biraz uzun oldu ama ayrıntılı anlatmaya çalıştım, yardımcı olabilirseniz sevinirim.
syg.

 

[Orion1]

Dosyanız ektedir.

Sub aktar()
Dim sat As Long, sut As Byte, i As Long, k As Range, adr As String
Sheets("toplam").Select
If Sheets("veri").Range("L1").Value < 1 Or Sheets("veri").Range("L1").Value > 31 Then
    MsgBox "veri sayfasındaki L1 hücresindeki değer 1 ila 31 arasında olmalıdır." & _
    "İşlem yapılmadı", vbCritical, "UAYARI"
    Exit Sub
End If
sut = ((13) + (Sheets("veri").Range("L1").Value * 6)) - 5
sat = Sheets("veri").Cells(65536, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range(Cells(26, sut), Cells(65536, sut + 1)).ClearContents
For i = 26 To Cells(65536, "A").End(xlUp).Row
    If Range("A" & i).Interior.Color = vbRed Then
        Set k = Sheets("veri").Range("A2:A" & sat). _
        Find(Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If k.Interior.Color = vbRed Then
                    Cells(i, sut).Value = k.Offset(0, 8).Value
                    Cells(i, sut + 1).Value = k.Offset(0, 9).Value
                    Exit Do
                End If
                Set k = Sheets("veri").Range("A2:A" & sat).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[kenangulal]

Sn, Evren Gizlen çok teşekür ederim, anlattıklarımın tam karşılığı olmuş, bu çalışma toplam 31 gün üzerinden yapılacak makroda 2 gün üzerinden sabit oldu, 31 güne çıkartma imkanı varmı?
syg.

 

[Selçuk1]

Merhaba sn.kenangulal,

dosyanız ektedir. inceleyin, isterseniz gerekli düzenlemeler yapılabilir...

iyi çalışmalar..

(toplam sayfasında sağ tarafa istediğiniz kadar sütun ekleyerek gün sayısını arttırabilirsiniz)

 

[kenangulal]

Sn, cellchug merhaba,
Denemek için yanına 10 adet daha giriş noktası ekledim fakat aşağıdaki hatayı verdi
syg.

"Object variable or With block variable not set (Error 91)"

 

[Orion1]

Sn, Evren Gizlen çok teşekür ederim, anlattıklarımın tam karşılığı olmuş, bu çalışma toplam 31 gün üzerinden yapılacak makroda 2 gün üzerinden sabit oldu, 31 güne çıkartma imkanı varmı?
syg.

Dosyayı güncelledim.
2 numaralı mesajdan dosyayı indirebilirsiniz.

 

[kenangulal]

Sn evren gizlen ,
Sn cellchug,

ikinizede ayrı ayrı teşekkür ederim iki farklı yolla çözüm sundunuz, her ikiside işimi görmekte,emekleriniz sağlık.
syg.

bu arada cellchug bey sorunu çözdüm
sut = s1.[a22:go22].Find(s2.Cells(1, "L")).Column kolonunda cc olan yeri go ile değiştirdim.
tekrar tşk.

 

[arif_olan]

Merhabalar Evren gizlen hocam, hesap çizelgesi adı altında bir excel çalışma kitabım var,Müşteri takip isimli sayfamda müşteri no ve diğer bilgileri yer almakta.

sizden ricam; müşteri takip sayfasında yer alan b sütunundaki verileri dikkate alarak şablon isimli sayfadaki çizelgeyi her bir müşteri için
abone numarası ile otomatik olarak makronun oluşturması.Müşteri takip sayfam sürekli olarak satır sayısı artan genel hesap tablom olacaktır.
Müşterilerimin ödeme bilgierini makronun otomatik açtığı çizelgede tutacağım ama aktar yada herhangi bir komut girmeksizin makronun müşterinin
kendi sayfasına eşzamanlı olarak veri girişi yapmasını istiyorum.

Yani Müş.Takip Çizelgesine girdiğim veri B sütunundaki koşula bağlı olarak daha önceden kayıtlı müşterimse onun sayfasına değilse de otomatik
olarak şablon sayfamdaki çizelgeyi kopyalayarak yeni müşterimin abone numarasını sayfa ismi olarak belirleyip otomatik olarak veriyi orada da tekralamasını istiyorum.

Yardımlarınız için şimdiden teşekkür ederim kolay gelsin..