Hi again

Your script works however when going to enter another set of new data in B6
and C6 it does not move the new data down to the next row.
Also how would I modify this script to work in several cells
Say for instance
b6 c6 b15 c16 b24 c24 etc etc etc

Thanks for the help
--
cruchnin numbers


"Per Jessen" wrote:

Hi

This will move data in B6:C6 and previously entered data below down one row.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C6" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
tRows = Range("B5").End(xlDown).Row - 1
With Target
.Offset(0, -1).Resize(tRows, 2).Copy .Offset(1, -1)
Range("B6:C6").Value = ""
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Regards,
Per

"belvy123" skrev i meddelelsen
...
Hi All

I have a sheet that I use the following script to move info on a new
entry.
It was written by Bob Phillips
I want to be able to use this script and add to it to do the following.

I want to enter a date in B6 and then in C6 enter a Number for a part.
When
I hit enter after entering the number in C6 I want to have the script move
the info in both B6 and C6 down 1 Row each time a new entry is made.
Thanks for the help

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String=
"B6,B15,B24,B33,E6,E15,E24,E33,H6,H15,H24,H33,K6,K 15,K24,K33,N6,N15,N24,N33,Q6,Q15,Q24,Q33"
'<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Resize(4).Copy .Offset(1, 0)
.Value = ""
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub
--
crunchin numbers