Hi Cutter

Sub test()
Dim r As Range, rr As Range
Set rr = ActiveCell
With Sheets("Sheet2")
If Application.CountA(.Range("D2:D729")) = 728 Then
MsgBox "No empty cells"
Else
Set r = _
..Range("D2:D729").SpecialCells(xlCellTypeBlanks). Cells(1)
r.Formula = rr.Value2
r.Offset(1, 0).EntireRow.Insert Shift:=xlDown
End If
End With
End Sub


--
XL2002
Regards

William



"Cutter " wrote in message
...
| Hi
|
| I'm hoping to get some help in writing a macro to do the following:
|
| Copy data that is in active cell on active sheet
| Go to first empty cell in range D9:D729 of Sheet2
| Paste the value only
| Drop down one row
| Insert one row
| End
|
| Any help is greatly appreciated.
| Thanks
|
|
| ---
| Message posted from http://www.ExcelForum.com/
|