Hi John,
Thx for that, however the code fails after For Each - I get an error that
the variable 'cell' has not been defined.

The following ode does the job but is obvioulsy inefficent - any thoughts?

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 24/11/2006 by MB'

'
Sheets("Sheet1 (3)").Select
Range("A3").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
Rows("2:3").Select
Selection.Delete Shift:=xlUp
Range("A4").Select
Selection.Cut
Range("E2").Select
ActiveSheet.Paste
Rows("3:4").Select
Selection.Delete Shift:=xlUp
Range("A5").Select
Selection.Cut
Range("E3").Select
ActiveSheet.Paste
Rows("4:5").Select
Selection.Delete Shift:=xlUp
End Sub

Best Wishes,
Mickey


"John Smith" wrote in message
...
Mickey wrote:
Hi,
I would appreciate any thoughts/help on this problem.

I have a series of data that is copied across from a database, this
populates three rows for each record of the database. I now need to copy
the contents of cell A3 into F3, this then repeats with each third row.
For
example cell A3, A6, A9, would be copied across to F3, F6 & F9 etc,
during
this process the 2nd & 3rd row are deleted.

In a nutshell the 2nd & 3rd row are deleted after the contents of the
required cell have been copied to another column. This then repeats for
all
entries.

Thanks for any help,
Mickey



Try this on a copy of your real data.

Sub deletecells()

Application.ScreenUpdating = False

For Each cell In Worksheets("sheet1").Range([a1],
[a65536].End(xlUp)).Cells
If (cell.Row() Mod 3) < 0 Then
cell.Value = ""
Else
cell.Offset(0, 5).Value = cell.Value
End If

Next cell

Application.ScreenUpdating = True

End Sub