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

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

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

Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow Step 3
If rng Is Nothing Then
Set rng = Rows(i + 1).Resize(2)
Else
Set rng = Union(rng, Rows(i + 1).Resize(2))
End If
Cells(i, "A").Copy Cells(i, "F")

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Mickey" wrote in message
...
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

Thanks Bob,
When 'run I get a Compile Error saying - End With without With

Any ideas?, I've had a stab at a few things but .........

Thanks for your help,
Mickey


"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow Step 3
If rng Is Nothing Then
Set rng = Rows(i + 1).Resize(2)
Else
Set rng = Union(rng, Rows(i + 1).Resize(2))
End If
Cells(i, "A").Copy Cells(i, "F")

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Mickey" wrote in message
...
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

My error, I missed a Next i

Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow Step 3
If rng Is Nothing Then
Set rng = Rows(i + 1).Resize(2)
Else
Set rng = Union(rng, Rows(i + 1).Resize(2))
End If
Cells(i, "A").Copy Cells(i, "F")
Next i

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Mickey" wrote in message
...
Thanks Bob,
When 'run I get a Compile Error saying - End With without With

Any ideas?, I've had a stab at a few things but .........

Thanks for your help,
Mickey


"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow Step 3
If rng Is Nothing Then
Set rng = Rows(i + 1).Resize(2)
Else
Set rng = Union(rng, Rows(i + 1).Resize(2))
End If
Cells(i, "A").Copy Cells(i, "F")

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Mickey" wrote in message
...
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

Thanks Bob,
I am very grateful to you, works a treat.

Best Wishes,
Mickey




"Bob Phillips" wrote in message
...
My error, I missed a Next i

Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow Step 3
If rng Is Nothing Then
Set rng = Rows(i + 1).Resize(2)
Else
Set rng = Union(rng, Rows(i + 1).Resize(2))
End If
Cells(i, "A").Copy Cells(i, "F")
Next i

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Mickey" wrote in message
...
Thanks Bob,
When 'run I get a Compile Error saying - End With without With

Any ideas?, I've had a stab at a few things but .........

Thanks for your help,
Mickey


"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim rng As Range

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow Step 3
If rng Is Nothing Then
Set rng = Rows(i + 1).Resize(2)
Else
Set rng = Union(rng, Rows(i + 1).Resize(2))
End If
Cells(i, "A").Copy Cells(i, "F")

If Not rng Is Nothing Then rng.Delete
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"Mickey" wrote in message
...
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