Hocalarım,
Bir çok sorumun cevabını burada buldum herkesin eline emeğine sağlık. Şöyle bir sorum olacak

Elimde 2 satır bağımsız makro kodu var. 

Bir tanesi bir sayfadaki filitrelenmiş öğeleri yapılan filitreye göre diğer sayfaya kopyalıyor.

Diğeri ise yine aynı sayfadaki öğeleri filitresine bakmayarak sadece 10 tane random şekilde ve benzersiz olacak şekilde başka sayfaya alıyor. Aslında benim isteğim bu iki kodun birleşimi. İkincisinin görevini yapsın fakat filitrelenen içeriği görsün diğerlerini görmesin.


Sadece filitrelenen alanı kopyalayan Komut

Sub FiltreyiKopyala()
Sheets("Sheet1").Range("A1:C10000").SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("HedefSayfa").Range("A1")
End Sub

Benzersiz random 10 tane kopyalayak komut :

Sub KopyalaBenzersizRastgeleSatir()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim tbl As ListObject
    Dim rowCount As Integer
    Dim uniqueRowCount As Integer
    Dim randomRowIndex As Integer
    Dim copiedRowCount As Integer
    Dim uniqueRows() As Boolean
    Dim i As Integer
    Dim newRow As Long
   
    ' Kaynak ve hedef sayfalari tanimla
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' Kaynak sayfa adini değistirebilirsin
    Set wsDestination = ThisWorkbook.Sheets("Hedef") ' Hedef sayfa
   
    ' Kaynak tablo ve satir sayisini al
    Set tbl = wsSource.ListObjects("Table1") ' Kaynak tablo adini değistirebilirsin
    rowCount = tbl.ListRows.Count
   
    ' Eğer tabloda 10 satirdan az varsa, tüm satirlari kopyala ve çik
    If rowCount <= 10 Then
        tbl.DataBodyRange.Copy Destination:=wsDestination.Range("A")
        Exit Sub
    End If
   
    ' Her satirin bir kez kopyalanip kopyalanmadiğini izlemek için bir dizi olustur
    ReDim uniqueRows(1 To rowCount)
   
    ' Benzersiz satir sayisini sifirla
    uniqueRowCount = 0
   
    ' Tüm satirlari kopyalanmamis olarak isaretle
    For i = 1 To rowCount
        uniqueRows(i) = True
    Next i
   
    ' Rastgele 10 benzersiz satir seçene kadar devam et
    Do While copiedRowCount < 10 And uniqueRowCount < rowCount
        randomRowIndex = Int((rowCount * Rnd) + 1)
       
        ' Eğer seçilen satir daha önce kopyalanmadiysa, kopyala
        If uniqueRows(randomRowIndex) Then
            tbl.ListRows(randomRowIndex).Range.Copy
            uniqueRows(randomRowIndex) = False
            copiedRowCount = copiedRowCount + 1
           
            ' Kopyalanan satirlari hedef sayfaya yapistir
            newRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
            wsDestination.Cells(newRow, "A").PasteSpecial Paste:=xlPasteAll
        End If
       
        ' Benzersiz satir sayisini artir
        uniqueRowCount = uniqueRowCount + 1
    Loop
   
    ' Panoyu temizle
    Application.CutCopyMode = False
End Sub