Tüm Sayfalardaki Kodları Birleştir ve Yinelenenleri Kaldır

[baydeniro]

Merhaba Arkadaşlar,
Çok sayfalı bir dosyada, tüm sayfaların A sütununda bulunan sayıları RAPOR sayfasında toplayıp tekrar eden verileri temizleyip, küçükten büyüğe doğru sıralatmak mümkün müdür ?

Örnek dosya linki >>

TUM_SAYFALARDA_YINELENENLERI_KALDIR.xls

View and download from Yandex.Disk

yadi.sk

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub OzetAl()

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

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
   
    For j = 1 To Sheets.Count
        If Sheets(j).Name <> "RAPOR" Then
            For i = 2 To Sheets(j).Cells(Rows.Count, "A").End(xlUp).Row
               deg = Sheets(j).Cells(i, "A")
               If Not d.exists(deg) Then
                   d.Add deg, Nothing
               End If
            Next i
        End If
    Next j
   
    Sheets("RAPOR").Select
    With Range("A2:A" & Rows.Count)
        .ClearContents
        Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys)
        .Sort , Key1:=Range("A2"), Order1:=xlAscending
    End With

End Sub

 

[baydeniro]

Merhaba,

Bu şekilde deneyin.

Sub OzetAl()

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

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
  
    For j = 1 To Sheets.Count
        If Sheets(j).Name <> "RAPOR" Then
            For i = 2 To Sheets(j).Cells(Rows.Count, "A").End(xlUp).Row
               deg = Sheets(j).Cells(i, "A")
               If Not d.exists(deg) Then
                   d.Add deg, Nothing
               End If
            Next i
        End If
    Next j
  
    Sheets("RAPOR").Select
    With Range("A2:A" & Rows.Count)
        .ClearContents
        Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys)
        .Sort , Key1:=Range("A2"), Order1:=xlAscending
    End With

End Sub

Ömer Üstadım, yardımınız için çok çok teşekkür ederim. Harika bir kod. sağoluni varolun, sağlıcakla kalın.