Excel İki sayfada benzeyen kayıtları tek sayaya toplar.

Excel İki sayfada benzeyen kayıtları tek sayaya toplar.

Sub ListeOluştur()

Set liste = Sheets("Liste")

liste.Range("A:A").ClearContents

x = 2

For Each sayfa In Sheets

If sayfa.Name <> liste.Name Then

    For a = 1 To sayfa.Range("B65500").End(3).Row

        For Each syf In Sheets

            If syf.Name <> liste.Name Then

                If WorksheetFunction.CountIf(syf.Range("B:B"), sayfa.Cells(a, "B")) > 0 Then

                    say = 1

                Else

                    say = 0

                    Exit For

                End If

            End If

        Next

       

        If say = 1 And WorksheetFunction.CountIf(liste.Range("A:A"), sayfa.Cells(a, "B")) = 0 Then

            liste.Cells(x, "A") = sayfa.Cells(a, "B")

            x = x + 1

        End If

        say = 0

    Next

End If

Next

End Sub