Excel Auto fill down VBA macro

Jyotirmaya

Board Regular
Joined
Dec 2, 2015
Messages
168
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
 

bhos123

Well-known Member
Joined
May 2, 2016
Messages
876
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
 

Jyotirmaya

Board Regular
Joined
Dec 2, 2015
Messages
168
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

Well-known Member
Joined
May 2, 2016
Messages
876
select the sheet and run the code, keep your data from row two on wards, assuming you have headers in row 1.
 

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
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):
Code:
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
 

Forum statistics

Threads
1,085,175
Messages
5,382,142
Members
401,775
Latest member
BredAnderson

Some videos you may like

This Week's Hot Topics

Top