(10/06/2024, 00:17)berduş yazdı: aşağıdaki kodu dener misiniz?

Sub SecmeliRastGele()

Set Rng = ThisWorkbook.Worksheets("ALL_DATA").Range("A1:C10000").SpecialCells(xlCellTypeVisible)



      rowCount = WorksheetFunction.CountA(Rng) / Rng.Columns.Count

    If rowCount <= 10 Then

        ThisWorkbook.Worksheets("ALL_DATA").Range("A1:C10000").SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Worksheets("HedefSayfa").Range("A1")

        Exit Sub

    End If

    Dim dzSecil As Variant

    ReDim dzSecil(1 To rowCount)

  

    i = 0

    For Each xRw In Rng.Rows

    i = i + 1

        dzSecil(i) = xRw.Value2

        If rowCount = i Then GoTo 10

    Next xRw

10

Dim dctIndx As Object: Set dctIndx = CreateObject("Scripting.Dictionary")

    Do While dctIndx.Count < 10

    TmpTrh = Int((rowCount * Rnd) + 1)

        If TmpTrh > 1 Then If Not dctIndx.Exists(TmpTrh) Then dctIndx.Add TmpTrh, 0

    Loop

 

  Dim dzTmp() As Variant

 ReDim dzTmp(0 To dctIndx.Count, 2)

 x = 0

        dzTmp(x, 0) = dzSecil(1)(1, 1)

        dzTmp(x, 1) = dzSecil(1)(1, 2)

        dzTmp(x, 2) = dzSecil(1)(1, 3)

 For Each Ky In dctIndx.keys

 x = x + 1

        dzTmp(x, 0) = dzSecil(Ky)(1, 1)

        dzTmp(x, 1) = dzSecil(Ky)(1, 2)

        dzTmp(x, 2) = dzSecil(Ky)(1, 3)

 Next

ThisWorkbook.Worksheets("HedefSayfa").Range("A1").Resize(UBound(dzTmp) + 1, 3) = dzTmp

End Sub

üstadım öncelikle eline sağlık. İstediğim gibi fakat birkaç  konu var düzeltilecek onuda yapabilirsen çok makbule geçer.
C sütunundaki verilerde duplicate olanı normalde getirmiyordu onu getiriyor şu anda.
Date/Time olan kısımda Hedef Sayfas'ına kopyalarken formatı tamamen değişiyor. Garip rakamlar çıkıyor
Bu kod her çalıştığında normalde varolanın sonuna eklerdi. Örn 1-10 11-21 21-31 31-41 gibi ekleyerek gidiyordu şuanda üstüne yazıyor.