aynı verıyı altalta cogaltmak

[kakara]

Merhaba ustadlarım aynı verıyı altalta cogaltmak ıstıyorum detaylı bılgıyı eklı dosyamda sızlerle paylastım ılgınız ıcın sımdıden tesekkurler

 

[Muzaffer Ali]

Merhaba.

Sub Test()
    Dim Snk As Range
    Dim Sira As Long
    Range("D2:D" & Rows.Count).ClearContents
    For Each Snk In Range("A:A").SpecialCells(xlCellTypeConstants, 23)
        Sira = Cells(Rows.Count, "D").End(xlUp).Row + 1
        Range("D" & Sira & ":D" & Sira + 4) = Snk.Value
    Next
    MsgBox "Tamamlandı"
End Sub

 

[veyselemre]

Sub test()
    Dim rng As Range
    Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
    If WorksheetFunction.CountBlank(rng) > 0 Then
        With rng
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
            .Value = .Value
        End With
    End If
End Sub

 

[yanginci34]

Merhaba, umarım böyle birşeydir kontrol edermisiniz

 

[kakara]

@Muzaffer Ali , @veyselemre , @yanginci34 ustadlarım tesekkurler ılgınızden dolayı