One way:
Option Explicit
Sub testme()
Dim myCell As Range
Dim myRng As Range
Dim myInsertRng As Range
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
With myCell
If IsNumeric(.Value) Then
.Offset(0, 2).Value = .Value
.ClearContents
ElseIf IsDate(.Value) Then
If myInsertRng Is Nothing Then
Set myInsertRng = .Cells
Else
Set myInsertRng = Union(.Cells, myInsertRng)
End If
End If
End With
Next myCell
If myInsertRng Is Nothing Then
'do nothing
Else
myInsertRng.EntireRow.Insert
End If
End With
End Sub
But you may want to reconsider inserting that row. I find just making the
rowheight twice as big looks just as nice and it makes subsequent processing a
lot easier.
I'd do it this way:
Option Explicit
Sub testme()
Dim myCell As Range
Dim myRng As Range
Dim myInsertRng As Range
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
With myCell
If IsNumeric(.Value) Then
.Offset(0, 2).Value = .Value
.ClearContents
ElseIf IsDate(.Value) Then
.RowHeight = .RowHeight * 2
End If
End With
Next myCell
End With
End Sub