Excel Auto fill down VBA macro

[Jyotirmaya]

In my Excel sheet there are ABCDE columns

D column is filled in with data. & I am filling down BCE columns by selecting & Pressing CTRL+D. I want a VBA macro to do this, the sheet is of 1000 rows.

data looks like this

I want the data to be like this

 

[Boller]

Here's a simple way to do it manually :
https://www.extendoffice.com/documents/excel/771-excel-fill-blank-cells-with-value-above.html

 

[bhos123]

Sub Macro1()

Dim x As Long
Dim y As Long
Dim lastrow As Long
Dim lastcolumn As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

For x = 2 To lastrow

If Cells(x, 2).Value = "" Then
Cells(x, 2).Value = Cells(x - 1, 2).Value
Cells(x, 3).Value = Cells(x - 1, 3).Value
Cells(x, 5).Value = Cells(x - 1, 5).Value
End If

Next x
Application.ScreenUpdating = True

End Sub

 

[Boller]

This question has been posted and answered many times on this forum.
For example:
http://www.mrexcel.com/forum/excel-...pplications-fill-blank-cells-above-value.html

 

[Jyotirmaya]

Sub Macro1()

Dim x As Long
Dim y As Long
Dim lastrow As Long
Dim lastcolumn As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

For x = 2 To lastrow

If Cells(x, 2).Value = "" Then
Cells(x, 2).Value = Cells(x - 1, 2).Value
Cells(x, 3).Value = Cells(x - 1, 3).Value
Cells(x, 5).Value = Cells(x - 1, 5).Value
End If

Next x
Application.ScreenUpdating = True

End Sub

How can I select range with this code ? and how to define the last row, the last row is being copying for so many rows

 

[bhos123]

select the sheet and run the code, keep your data from row two on wards, assuming you have headers in row 1.

 

[Boller]

The following macro is based upon my previous two posts.
Assuming Column D can be used to find the last row (and there are no fomulas in col D):

Sub FillBlanks()
Dim rng As Range
On Error Resume Next
Set rng = Range([A1], Cells(Cells(Rows.Count, "D").End(xlUp).Row, "E"))
Application.DisplayAlerts = False
With rng
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
End With
Application.DisplayAlerts = True
On Error GoTo 0
End Sub