Macro giving me grief..

V

Voutsy

Hi,
I am trying to write/record a Macro that at the press of a button (
have inserted a button at the end of each row) will select all th
cells in the row before the button, cut them, delete the empty row tha
they came from and them paste the selection in the next available blan
row in sheet2 (the table in sheet 2 is exactly the same layout as i
sheet 1).

So far i have got:

Sub click_to_complete()
'
' click_to_complete Macro
' Macro recorded 28/05/2004 by Me
'

'
Range("B2:E2").Select
Range("E2").Activate
Selection.Cut
Sheets("Sheet2").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp
End Sub

This sort of works but it keeps on overwriting on the same line o
sheet2. I know i could write a seperate macro for each button on eac
line but i have over 600 rows to do this for and am looking for th
quickest easiest way to do this.

Can anyone help with this,
any help will be greatly appreciated

thank
 
J

JulieD

Hi Voutsy

the following should solve your problem

in your code replace
Range("B2").Select

with
****
If Sheet2.Range("B3").Value = "" Then
Range("B3").Select
Else
Range("B2").End(xlDown).Offset(1, 0).Select
End If
*****
if you would like to explain a bit more about the criteria that you're using
the select the 600 rows to move to sheet 2 we might be able to assist with a
better solution.

Regards
JulieD
 
B

Bob Phillips

This might be what you want

Sub click_to_complete()
Dim iRow As Long

iRow=Activecell.Row
Range("B" & iRow & ":E" & iRow).Cut
Sheets("Sheet2").Select
Range("B" & iRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Rows(iRow & ":" & iRow).Delete Shift:=xlUp
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Top