Copy Paste VBA

[PivotIdiot]

Hi All,

Struggling with some simple code - cant seem to get it right....

Sub Macro1()
' Macro1 Macro
' Keyboard Shortcut: Ctrl+Shift+M
'
    ActiveCell.Select
    Selection.Copy
    Range(Selection.End(xlDown), Offset(-1)).Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
End Sub

Im trying copy the contents of the current cell into all the empty cells below, then go to the new cell to repeat.
For example.....

Book1.xlsm
	V	W
1362	DRN	90SR6
1363	DRN	90SR6
1364	DRN	90SR6
1365	DRN	90SR6
1366	DRN	80MK4
1367	DRN	80MK4
1368	DRN	80MK4
1369	DRN	80MK4
1370	DRN	90SR6
1371	DRN
1372	DRN
1373	DRN
1374	DRN
1375	DRN	80MK4
1376	DRN
1377	DRN
1378	DRN
1379	DRN
1380	DRN
1381	DRN
1382	DRN
1383	DRN
1384	DRN
1385	DRN
1386	DRN
1387	DRN
1388	DRN
1389	DRN
1390	DRN
1391	DRN
1392	DRN
1393	DRN	80MK4
1394	DRN
1395	DRN
1396	DRN
1397	DRN
Table 1

Any help appreciated

 

[Saurabhj]

Hi, have you checked the below code ?

Sub copyData()
Dim lastRow As Integer, rowno As Integer
Dim pasteRow As Integer
lastRow = WorksheetFunction.CountA(Worksheets("Sheet2").Range("A:A"))

For rowno = 2 To lastRow
    Sheets("Sheet2").Range("B" & rowno).Copy
    For pasteRow = rowno + 1 To lastRow
        If Sheets("Sheet2").Range("B" & pasteRow) = vbNullString Then
            Sheets("Sheet2").Range("B" & pasteRow).Select
            Sheets("Sheet2").Paste
        Else
            rowno = pasteRow - 1
            Exit For
        End If
    Next
    
Next
End Sub

 

[MARK858]

Do you mean something like the below?

Sub FillCell1()
    Dim fCell As Range
    On Error Resume Next

    For Each fCell In Range("W2:W" & Range("V" & Rows.Count).End(xlUp).Row). _
        SpecialCells(xlCellTypeBlanks).Areas
        fCell.Value = fCell(1).Offset(-1).Value
    Next

    On Error GoTo 0
End Sub