Eğer B sütunu ve J sütunu kayıtları aynıysa

[kelkitli]

Değerli Dostlar Selamlar,
Şu kodlarla "işleticiler"isimli sayfadan "tahakkukedenborç" sayfasına ThisWorbook ta yazılı şu makro ile tahakkuk kayıtları oluşturuyorum.

Private Sub Ayın_1_Tahakkuk_Eden()
Application.ScreenUpdating = False
Dim SonSatir, Satir, Say, Borc As Double
Dim IslemNo, SraNo As Long
Dim HatAdi As String
Dim S1, S2, S3 As Worksheet
Dim Bak, Ara As Range
Set S1 = ThisWorkbook.Worksheets("işleticiler")
Set S2 = ThisWorkbook.Worksheets("tahakkukedenborç")
Set S3 = ThisWorkbook.Worksheets("bilgiler")

Say = S1.Cells(65536, "A").End(3).Row

For Each Bak In S1.Range("A2:A" & Say)
'Hatadi
HatAdi = S1.Range(Bak.Offset(0, 4).Address).Value

SonSatir = S2.Cells(65536, "A").End(3).Row
SraNo = Val(S2.Cells(SonSatir, "A").Value)
If SraNo = 0 Then
SraNo = Val("1")
Else
SraNo = Val(S2.Cells(SonSatir, "A").Value) + 1
End If
IslemNo = Val(S2.Cells(SonSatir, "b").Value)
If IslemNo = 0 Then
IslemNo = Val("2008000001")
Else
IslemNo = Val(S2.Cells(SonSatir, "b").Value) + 1
End If
S2.Cells(SonSatir + 1, "a").Value = SraNo
S2.Cells(SonSatir + 1, "B").Value = IslemNo
S1.Range(Bak.Offset(0, 1), Bak.Offset(0, 5).Address).Copy
S2.Cells(SonSatir + 1, "C").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Say1 = S3.Cells(65536, "A").End(3).Row
For Each Ara In S3.Range("A2:A" & Say1)
If Ara = HatAdi Then
Borc = S3.Range(Ara.Offset(0, 5).Address).Value * S3.Range("H1")
S2.Cells(SonSatir + 1, "H").Value = Borc
S2.Cells(SonSatir + 1, "J").Value = Date
Exit For
End If
Next Ara
Next Bak
Application.CutCopyMode = False
End Sub

Yapmaya çalıştığım şu:
Çalışma kitabı her açılış kapanışta kayıtları yeniden oluştururken, "tahakkukedenborç" isimli sayfada C sütununda aktarılan kayda ait plaka no su ve J sütununda ki tarih kaydı (01.01.2008 şeklinde yazılı bu kaydı, ay olarak (Month(J?))şeklinde) o ay daha önce girilmişse aktarılan satırı yazmasın, döngü devam etsin.