Sayfa 1 de masraf yazdığımda diğer sayfaya yazması için ne yapmalıyım?

[deleterx]

Merhaba ekteki dosyayı ornek olarak hazırladım. Sayfa 1 de E sütunundaki işlem kısmına masraf yazdığımda o satırı sayfa 2 deki en son yazılan kaydın altındaki satıra yazsın istiyorum ne yapmalıyım?


http://s5.dosya.tc/server/er3mkr/deneme.xlsx.html

Teşekkürler.

 

[vardar07]

Sayfa1 in kod bölümüne aşağıdaki kodu ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
If Intersect(Target, Range("E2:E" & Range("A1048576").End(3).Row)) Is Nothing Then Exit Sub 'KOLONDA DEĞİŞİM
If S1.Cells(Target.Row, "E") = "masraf" Then
son = S2.Range("A1048576").End(3).Row + 1
S2.Cells(son, "A").Value = S1.Cells(Target.Row, "A").Value
S2.Cells(son, "B") = S1.Cells(Target.Row, "B")
S2.Cells(son, "C") = S1.Cells(Target.Row, "C")
S2.Cells(son, "D") = S1.Cells(Target.Row, "D")
S2.Cells(son, "E") = S1.Cells(Target.Row, "E")
End If
End Sub

 

[deleterx]

Sayfa1 in kod bölümüne aşağıdaki kodu ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
If Intersect(Target, Range("E2:E" & Range("A1048576").End(3).Row)) Is Nothing Then Exit Sub 'KOLONDA DEĞİŞİM
If S1.Cells(Target.Row, "E") = "masraf" Then
son = S2.Range("A1048576").End(3).Row + 1
S2.Cells(son, "A").Value = S1.Cells(Target.Row, "A").Value
S2.Cells(son, "B") = S1.Cells(Target.Row, "B")
S2.Cells(son, "C") = S1.Cells(Target.Row, "C")
S2.Cells(son, "D") = S1.Cells(Target.Row, "D")
S2.Cells(son, "E") = S1.Cells(Target.Row, "E")
End If
End Sub

Merhaba Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan başka bir kod olduğundan hata veriyor.Kodu paylaşıyorum sizinle.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 And Cells(Target.Row, "D") = "" Then Exit Sub
    If Target.Column = 4 And Cells(Target.Row, "C") = "" Then Exit Sub
    If Cells(Target.Row, 4) <> "ZİRAAT" And Cells(Target.Row, 4) <> "GARANTİ" _
         And Cells(Target.Row, 4) <> "İŞBANKASI" And Cells(Target.Row, 4) <> "FİNANSBANK" _
         And Cells(Target.Row, 4) <> "Vakıfbank" And Cells(Target.Row, 4) <> "ykb" _
         And Cells(Target.Row, 4) <> "AKBANK" _
         Then Exit Sub
    If Target.Column = 3 Or Target.Column = 4 Then
        If Not Cells(Target.Row, 2) = "Havale Masrafı" And Cells(Target.Row, 3) < -99 And Cells(Target.Row, 4) <> "" Then
        'Degerler Cells(Target.Row, 4).Text
        'Cells(Target.Row + 1, 2) = Degerler(0)
            Application.EnableEvents = False
            Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 5)) = Degerler(Cells(Target.Row, 4).Text)
            Cells(Target.Row + 1, 1) = Cells(Target.Row, 1)
            Cells(Target.Row + 1, 3) = Cells(Target.Row + 1, 3) * 1
            Application.EnableEvents = True
        End If
    End If
End Sub

Teşekkürler

 

[vardar07]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 And Cells(Target.Row, "D") = "" Then Exit Sub
    If Target.Column = 4 And Cells(Target.Row, "C") = "" Then Exit Sub
    If Cells(Target.Row, 4) <> "ZİRAAT" And Cells(Target.Row, 4) <> "GARANTİ" _
         And Cells(Target.Row, 4) <> "İŞBANKASI" And Cells(Target.Row, 4) <> "FİNANSBANK" _
         And Cells(Target.Row, 4) <> "Vakıfbank" And Cells(Target.Row, 4) <> "ykb" _
         And Cells(Target.Row, 4) <> "AKBANK" _
         Then Exit Sub
    If Target.Column = 3 Or Target.Column = 4 Then
        If Not Cells(Target.Row, 2) = "Havale Masrafı" And Cells(Target.Row, 3) < -99 And Cells(Target.Row, 4) <> "" Then
        'Degerler Cells(Target.Row, 4).Text
        'Cells(Target.Row + 1, 2) = Degerler(0)
            Application.EnableEvents = False
            Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 5)) = Degerler(Cells(Target.Row, 4).Text)
            Cells(Target.Row + 1, 1) = Cells(Target.Row, 1)
            Cells(Target.Row + 1, 3) = Cells(Target.Row + 1, 3) * 1
            Application.EnableEvents = True
        End If
    End If
'XXXXXXXX Eklenen
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
If Intersect(Target, Range("E2:E" & Range("A1048576").End(3).Row)) Is Nothing Then Exit Sub 
If S1.Cells(Target.Row, "E") = "masraf" Then
son = S2.Range("A1048576").End(3).Row + 1
S2.Cells(son, "A").Value = S1.Cells(Target.Row, "A").Value
S2.Cells(son, "B") = S1.Cells(Target.Row, "B")
S2.Cells(son, "C") = S1.Cells(Target.Row, "C")
S2.Cells(son, "D") = S1.Cells(Target.Row, "D")
S2.Cells(son, "E") = S1.Cells(Target.Row, "E")
End If
End Sub