Mükerrer isimler sayfalardan alma

[5353]

Bir çalışma kitabımda 1 den 15 e kadar sayfalarım var. Her sayfada E12 den e 55 satır arasında Farklı isimler var. Bu isimlerden bazıları aynı. Bu sayfa ve aralıklardan mükerrer olanları tek sayarak bana Çıktı sayfasında A1 den aşağıya doğru sıralansın. Böyle bir formül yazabilir miyiz ? teşekkürler.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Ozet_Al()

    Dim d As Object, j As Integer, i As Long, s, deg

    Set d = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Sheets("Çıktı").Select
    Range("A:A").ClearContents

    For j = 1 To Worksheets.Count
        With Sheets(j)
            If .Name <> "Çıktı" Then
                For i = 12 To .Cells(Rows.Count, "E").End(xlUp).Row
                    deg = .Cells(i, "E")
                    If Not d.exists(deg) Then
                        d.Add deg, Nothing
                    End If
                Next i
            End If
        End With
    Next j
            
    Range("A1").Resize(d.Count, 1) = _
        Application.Transpose(Array(d.keys))
        
    Application.ScreenUpdating = True

End Sub

.

 

[5353]

Teşekkürler formül işe yaradı.