Kontrol edıp yenı bır lıste oluşturmak

[haso_excel]

Merhaba arkadaşlar,
Soru bana biraz karmaşık geldiği için nasıl soracağımı örnek bir dosya hazırlayarak sormaya çalıştım. Yardımlarınızı bekliyorum.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Not: Sn. veyselemre beyin uyarısı ile A sütunundaki verileriniz sırasız dahi olsa kodun doğru çalışması için kırmızı renkli satır düzenlenmiştir.

Option Explicit
 
Sub LİSTE_OLUŞTUR()
    Dim X As Long, SATIR As Long, BUL_SATIR As Long, SAY As Integer, Y As Integer
 
    Range("F2:G65536").ClearContents
    SATIR = 2
 
    For X = 2 To Range("D65536").End(3).Row
    SAY = WorksheetFunction.CountIf(Range("A:A"), Cells(X, "C"))
    BUL_SATIR = Range("A:A").Find(Cells(X, "C"), LookAt:=xlWhole).Row
    If SAY > 0 Then
        For Y = 1 To SAY
            Cells(SATIR, "F") = Cells(X, "D")
            Cells(SATIR, "G") = Cells(BUL_SATIR, "B")
            SATIR = SATIR + 1
            [COLOR=red]BUL_SATIR = Range("A:A").FindNext(After:=Cells(BUL_SATIR, 1)).Row[/COLOR]
        Next
    End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[haso_excel]

Teşekkür ederim elinize sağlık.