ilgili sayfaya aktarım

[Fuat Şirin]

arkadaşlar ekli dosyamda çek günü geldiğinde hangi firmaya aitse o sayfaya hesabın geçmesini istiyorum..
yani şöle ki çek sayfamda kestiğim çekler var bu çekler ytl olarak günü geldiğinde o günkü kurla çarpıcam kişinin sayfasına geçicek
şimdiden yardımlarını için çok teşekkür..

 

[Fuat Şirin]

arkadaşlar yardımcı olacak kimse yok mu
çok rica

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Sheets("ÇEK").Activate
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) = Date Then
    Satır = Sheets(Cells(X, 3).Text).[A65536].End(3).Row + 1
    Sheets(Cells(X, 3).Text).Cells(Satır, 1) = Date
    Sheets(Cells(X, 3).Text).Cells(Satır, 2) = Cells(X, 2) & " nolu çeke istinaden"
    Sheets(Cells(X, 3).Text).Cells(Satır, 9) = Cells(X, 6)
    End If
    Next
    MsgBox Date & " TARİHİNE AİT ÇEKLER İLGİLİ CARİ HESAPLARA AKTARILMIŞTIR.", vbInformation
End Sub

 

[Fuat Şirin]

hocam çok güzel bunu birde kırmızı renkte atabilir miyiz
aktardığımızıda kırmızı yapsa çok şeymi istemiş oluruz
saygılar

 

[Fuat Şirin]

bu konuda yardımcı olursanız sevinirim

 

[Orion1]

hocam çok güzel bunu birde kırmızı renkte atabilir miyiz
aktardığımızıda kırmızı yapsa çok şeymi istemiş oluruz
saygılar

Aşağıdaki kırmızı ile yazılmış kodları sayın COST_CONTROL'un kodlarına ekledim.

Sub AKTAR()
    Sheets("ÇEK").Activate
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) = Date Then
    satır = Sheets(Cells(X, 3).Text).[A65536].End(3).Row + 1
    Sheets(Cells(X, 3).Text).Cells(satır, 1) = Date
    Sheets(Cells(X, 3).Text).Cells(satır, 2) = Cells(X, 2) & " nolu çeke istinaden"
    Sheets(Cells(X, 3).Text).Cells(satır, 9) = Cells(X, 6)
    [B][COLOR="Red"]Sheets(Cells(X, 3).Text).Range(Cells(satır, 1), Cells(satır, 2)).Interior.ColorIndex = 3
    Sheets(Cells(X, 3).Text).Cells(satır, 9).Interior.ColorIndex = 3[/COLOR][/B]
    End If
    Next
    MsgBox Date & " TARİHİNE AİT ÇEKLER İLGİLİ CARİ HESAPLARA AKTARILMIŞTIR.", vbInformation
End Sub

 

[Fuat Şirin]

hocam ekledim ama sadece tutarı o renk yapıyor
acaba satırı komple (arka kısmı değilde yazıyı kırmızı yapsa)
birde gönderiğini kırmızı yapsa
hani bu kayıt işlenmiştir gibi

 

[Orion1]

hocam ekledim ama sadece tutarı o renk yapıyor
acaba satırı komple (arka kısmı değilde yazıyı kırmızı yapsa)
birde gönderiğini kırmızı yapsa
hani bu kayıt işlenmiştir gibi

aşağıdaki kırmız ile belittiğim satırları ekledim.

Sub AKTAR()
    Sheets("ÇEK").Activate
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) = Date Then
    satır = Sheets(Cells(X, 3).Text).[A65536].End(3).Row + 1
    Sheets(Cells(X, 3).Text).Cells(satır, 1) = Date
    Sheets(Cells(X, 3).Text).Cells(satır, 2) = Cells(X, 2) & " nolu çeke istinaden"
    Sheets(Cells(X, 3).Text).Cells(satır, 9) = Cells(X, 6)
    [B][COLOR="Red"]Sheets(Cells(X, 3).Text).Rows(satır).Interior.ColorIndex = 3
    Sheets("ÇEK").Rows(X).Interior.Color.Index = 3[/COLOR][/B]
    End If
    Next
    MsgBox Date & " TARİHİNE AİT ÇEKLER İLGİLİ CARİ HESAPLARA AKTARILMIŞTIR.", vbInformation
End Sub

 

[Fuat Şirin]

hocam çok güzelde
arka plan değilde sadece yazı kırmızı olsa
bunun gibi

 

[Fuat Şirin]

hocam birde çek sayfasında o satırı renkli yapmıyor
hata veriyor

 

[Orion1]

hocam çok güzelde
arka plan değilde sadece yazı kırmızı olsa
bunun gibi

Aşağıdaki kodları kullanınız.

Sub AKTAR()
    Sheets("ÇEK").Activate
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) = Date Then
    satır = Sheets(Cells(X, 3).Text).[A65536].End(3).Row + 1
    Sheets(Cells(X, 3).Text).Cells(satır, 1) = Date
    Sheets(Cells(X, 3).Text).Cells(satır, 2) = Cells(X, 2) & " nolu çeke istinaden"
    Sheets(Cells(X, 3).Text).Cells(satır, 9) = Cells(X, 6)
    [B][COLOR="Red"]Sheets(Cells(X, 3).Text).Rows(satır).Font.ColorIndex = 3
    Sheets("ÇEK").Rows(X).Font.ColorIndex = 3[/COLOR][/B]
    End If
    Next
    MsgBox Date & " TARİHİNE AİT ÇEKLER İLGİLİ CARİ HESAPLARA AKTARILMIŞTIR.", vbInformation
End Sub

 

[Fuat Şirin]

hocam harikasınız çok thank you çok teşekkür

 

[Orion1]

hocam harikasınız çok thank you çok teşekkür

Rica ederim.
İyi çalışmalar.