Günlük sayfasının A ve B sütunundaki veriler gerçekleşirse tsb sayfasına taşıma

[hsayar]

Arkadaşalar aşağıdaki kodları ayrı ayrı çalıştırarak istediğim elde ediyorum.
Ancak şimdi şöyle bir sorun oluştu ayrı ayrı iken bu işlemi yapamıyorum

Günlük sayfası A3:A65536 aralığındaki değerler "ev"ise ev() kodu işimi görüyor yani öce günlük sayfasının 11. satırından 44. satırına kadar A,B,E sütunlarına sonrada G,H,K sütunlarına kopyalıyor...

Günlük sayfası A3:A65536 aralığındaki değerler "ev"

Ancak
Günlük sayfası A3:A65536 aralığındaki değerler "ev", Günlük sayfası b3:b65536 aralığındaki değerler "v", ise ev() kodu işimi görüyor yani öce günlük sayfasının 11. satırından 44. satırına kadar A,B,E sütunlarına sonrada G,H,K sütunlarına kopyalayacak ve kopyaladığı verinin fontunu kırmızı yapacak

bunun için ilk kodabir şeyler yazmak lazım ama ben şimdilik işin içiden çıkamadım.
Derdimi türkçe, excelce karışık yazdım.

İf A3:A65536="ev" Then
if b3:b65536="p" then
'ilk kodda değişiklik olmayacak aynen kopyalayacak
elseif Eğer b3:b65536="v" then
'Kopyalamasına kopyalayacak ve kopyaladıktan sonra zemin rengi %25 gri, font rengi Beyaz, kalın olacak.
'2. kodda yaptığımız işlemler yani tsb de 25,26,29. sütunlarının 11:44 atırlarına yazılacak.
herhalde derdimi anlatabildim.

Saygılarımla

Sub ev()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>ev
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Ev" Then
c = c + 1
If c = 35 Then
sut = 6
c = 1
End If
If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 1 + sut) = s1.Cells(g, 5)
s2.Cells(c + 10, 2 + sut) = s1.Cells(g, 4)
s2.Cells(c + 10, 5 + sut) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

Sub Veresiye()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>veresiye
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 2) = "V" Then
'c = 0
c = c + 1
'If c = 35 Then sut = 6 : c = 1 : End If
If WorksheetFunction.CountA(s2.[ac11:ac44]) = 34 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 25) = s1.Cells(g, 3)
s2.Cells(c + 10, 26) = s1.Cells(g, 4)
s2.Cells(c + 10, 29) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

 

[hsayar]

örnek dosya isterseniz aşağıdaki linkte var bana balıpın yönünü söyleyin yeter diğer kısımlar için ben değerlendiririm
http://www.excel.web.tr/showthread.php?t=38604

 

[hsayar]

Sub ev()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'evstokçıkışyaz>>>>>>>>>>>>>>>>>>>>>>>>>
For g = 3 To s1.[a65536].End(3).Row
    '12+P>>>>>>>>>>>>>>
    If s1.Cells(g, 1) = "12" And (s1.Cells(g, 2) = "P" Or s1.Cells(g, 2) = "p") Then
    c = c + 1
        'ikinci sütun kontrolü
        If c = 35 Then
        sut = 6: c = 1
        End If
        'Kayıt sayısı kontrolü
        If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then
        MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI": Exit Sub
        End If
    '12 lik stok çıkış yazma işlemi
    s2.Cells(c + 10, 1 + sut) = s1.Cells(g, 5)
    s2.Cells(c + 10, 2 + sut) = UCase(s1.Cells(g, 4))
    s2.Cells(c + 10, 5 + sut) = s1.Cells(g, 7)
    '<<<<<<<<<<<<<<12+P
    '--------------------------------------------
    '12+V>>>>>>>>>>
    ElseIf s1.Cells(g, 1) = "12" And (s1.Cells(g, 2) = "V" Or s1.Cells(g, 2) = "v") Then
    c = c + 1
        'ikinci s&#252;tun kontrol&#252;
        If c = 35 Then
        sut = 6: c = 1
        End If
        'ev stok Kay&#305;t say&#305;s&#305; kontrol&#252;
        If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then
        MsgBox "Tablo doldu&#287;u i&#231;in kay&#305;t yap&#305;lamad&#305;.", , "UYARI": Exit Sub
        End If
    '12 lik stok &#231;&#305;k&#305;&#351; yazma i&#351;lemi
    s2.Cells(c + 10, 1 + sut) = s1.Cells(g, 5)
    s2.Cells(c + 10, 2 + sut) = UCase(s1.Cells(g, 4)): s2.Select: Cells(c + 10, 2 + sut).Select: Selection.Font.ColorIndex = 2: Selection.Interior.ColorIndex = 15: Selection.Font.Bold = True ''se&#231;ili h&#252;creyi gri dolgu,beyaz kal&#305;n yaz
    s2.Cells(c + 10, 5 + sut) = s1.Cells(g, 7)
    '<<<<<<<<<<<<<<<<<12+V
    End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<evstok&#231;&#305;k&#305;&#351;yaz
End Sub

yazarak
12 ve p leri normal yazı ile
12 ve v leri %25 gri zemin üzerine beyaz kalın fon ile yazmayı başardım.

Ancak 12 ve v ise Veresiye kolonuna yanı anda yazdıramıyorum bunun bir yolu varmı ?