Soru Hücre içeriğine göre Kod Türetme

[leonadies]

Merhaba Üstadlar
Sayfa1 "D7 : D1000" arası tekrar edebilen metinlerim var. İsteğim şöyle

Öncelikle Sayfa1 "D7 : D1000" aralığındaki metinler benzersiz olacak şekilde Sayfa2 "C:C" sütununa kopyalansın.
Sonra Sayfa2 "D : D " sütununda karşılarına tamamen rastgele (101-999) arası sayılar üretip bıraksın. Bu kadar

Mümkün müdür?

 

[Necdet]

Merhaba,

Public Sub deneme()

Dim arr As Variant, _
    col As New Collection, _
    i   As Long
Sheets("Sayfa2").Range("C:D").ClearContents

arr = Sheets("Sayfa1").Range("D7:D" & Sheets("Sayfa1").Range("D7").End(xlDown).Row).Value

For i = LBound(arr, 1) To UBound(arr, 1)
    On Error Resume Next
    col.Add arr(i, 1), arr(i, 1)
    On Error GoTo 0
Next i

Erase arr

ReDim arr(col.Count)
For i = 1 To col.Count
    arr(i - 1) = col.Item(i)
Next i

Sheets("Sayfa2").Range("C1").Resize(UBound(arr, 1), 1) = _
    Application.WorksheetFunction.Transpose(arr)

For i = LBound(arr) To UBound(arr)
    arr(i) = Application.WorksheetFunction.RandBetween(101, 999)
Next i

Sheets("Sayfa2").Range("D1").Resize(UBound(arr, 1), 1) = _
    Application.WorksheetFunction.Transpose(arr)

End Sub

 

[leonadies]

@Necdet Teşekkürler üstadım