Hi Sige,

No enhancements needed ... or if so, the inheritance of the
Font-formatting?

Try:
'=============
Public Sub Tester2()
Dim rng As Range
Dim rng2 As Range
Dim rCell As Range

On Error Resume Next
Set rng = Intersect(ActiveSheet.UsedRange, Columns("A"))
Set rng2 = rng.SpecialCells(xlBlanks)
On Error GoTo 0

If Not rng2 Is Nothing Then
For Each rCell In rng2.Cells
With rCell
.End(xlToRight).Copy Destination:=.Item(1)
End With
Next rCell
End If

End Sub
'<<=============


---
Regards,
Norman



"Sige" wrote in message
oups.com...
Hi Norman,

Thanks again.
It does exactly what it should!
No enhancements needed ... or if so, the inheritance of the
Font-formatting?

Brgds Sige


Norman Jones wrote:
Hi Sige,

Looking again at your example data, change:

.Resize(1, 2) = .End(xlToRight).Value

to:

.Value = .End(xlToRight).Value

---
Regards,
Norman