Rakamları cıft rakamlı bos olan hucreleye yerlestırme

[gergun]

Sol tablodakı aynı satırdakı rakamları sag taraftakı tabloda x ıle ısaretlenmemıs bos olan cıft rakamlı sutunlara yanı
2-4-6-8-10-12… sutunlarına karısık veya sıralı bır sekılde dagıtacak bır makroyu nasıl olusturabılırım

tesekkur ederım

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kdu denermisiniz.

Option Explicit
 
Sub SAYILARI_DAĞIT()
    Dim Alan As Range, Sütun As Integer, X As Integer, Y As Byte
    
    Application.ScreenUpdating = False
    
    Set Alan = Range("R3:BY10")
    
    On Error Resume Next
    Alan.SpecialCells(xlCellTypeConstants, 1).ClearContents
    On Error GoTo 0
    
    For X = 3 To Range("A65536").End(3).Row
        For Y = 1 To 15
            If Cells(X, Y) <> "" Then
Başla:
            Randomize
            Sütun = Int(Rnd() * 77 + 1)
                If Sütun > 17 Then
                    If Cells(X, Sütun) <> "X" And Sütun Mod 2 = 0 Then
                        If Cells(X, Sütun) <> "" Then GoTo Başla
                        Cells(X, Sütun) = Cells(X, Y)
                    Else
                        GoTo Başla
                    End If
                Else
                    GoTo Başla
                End If
            End If
        Next
    Next
        
    Set Alan = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[gergun]

Korhan bey merhaba,

Harikasınız. tam olarak istediğim gibi. yardımınız için minnettarım,
iyi çalışmalar

saygılarımla