Hücre sayısına göre kopyalama

[inflexible]

Sevgili arkadaşlar ,
B1 hücresindeki değeri "B2:B9" arasına kopyalamak ve bunu tüm sayfa boyunca makro ile yapmak istiyorum. Örnek dosya ektedir.

 

[askm]

Sub askm()
Dim son As Long
son = Range("D" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To son
    If Cells(i, 2) = "" Then
        Cells(i, 2) = Cells(i - 1, 2)
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[inflexible]

Hocam , Makro hata veriyor.

 

[YUSUF44]

Sayın askm'nin makrosu herhangi bir hata vermedi. sizde nasıl bir hata verdiğini gösterirseniz iyi olur.

Yine de kodu aşağıdaki gibi kullanırsanız hem daha çabuk hem de son satır için de işlem yapar:

Sub askm()
Dim son As Long
son = Range("D" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To son Step 10
    Range("B" & i + 1 & ":B" & i + 9) = Cells(i, "B")
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub