Snasui Excel Forum

Code: Select all

Sub FillBlanks()
     Dim r As Range
     Dim sh As Worksheet
     On Error Resume Next
     For Each sh In Worksheets
         For Each r In sh.UsedRange. _
                 SpecialCells(xlCellTypeBlanks)
            r.Value = r.Offset(1, 0).Value
         Next r
    Next sh
    MsgBox "Finished.", vbInformation
End Sub

Code: Select all

Sub FillBlanks()
On Error Resume Next
With ActiveSheet
  For i = .Range("d" & .Rows.Count).End(xlUp).Row To 1 Step -1
          If .Cells(i, 5).Value = "" Then
              .Cells(i, 5).Resize(, 12).Value = .Cells(i, 5).Offset(1).Resize(, 12).Value
        End If
    Next
End With
MsgBox "Finished.", vbInformation
End Sub

Code: Select all

Sub FillBlanks()
    Dim rAll As Range
    On Error Resume Next
    Set rAll = Worksheets(1).UsedRange.SpecialCells(xlCellTypeBlanks)
    rAll.Formula = "=R[1]C"
    rAll.CurrentRegion.Value = rAll.CurrentRegion.Value
    MsgBox "Finished.", vbInformation
End Sub[/c]