Help needed modifying worksheet change vba copy/paste code

[rexel12]

Hi,

I have a spreadsheet with a number of worksheets. I have modified some of FireFytrs code to do the following (see below): In sheet 1 if the user keys X in a cell in column D, then the three cells to the left are automatically copied to sheet 2 to the next free cell in column A. This works fine.

What I need to do is if X is keyed into column E then automatically copy three cells to the left to sheet 3 to the next free cell in column A. I need to repeat this upto column G.

Any help greatly appreciated.


Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
If Target.Count > 1 Then Exit Sub
Set rng = Range("D:D")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Range(Target, Target.Offset(0, -3)).Copy _
Destination:=Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1)


End Sub

 

[phantom1975]

Re: Help needed modifying worksheet change vba copy/paste co

You could try this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
If Target.Count > 1 Then Exit Sub
Set rng = Range("D:D")
If Intersect(Target, rng) Is Nothing Goto ESpot
Range(Target, Target.Offset(0, -3)).Copy _
Destination:=Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1)
ESpot:
If Target.Count > 1 Then Exit Sub
Set rng = Range("E:E")
If Intersect(Target, rng) Is Nothing Then Goto FSpot
Range(Target, Target.Offset(0, -3)).Copy _
Destination:=Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1)
FSpot:
If Target.Count > 1 Then Exit Sub
Set rng = Range("F:F")
If Intersect(Target, rng) Is Nothing Then Goto GSpot 'My little joke here
Range(Target, Target.Offset(0, -3)).Copy _
Destination:=Sheets("Sheet4").Range("A65536").End(xlUp).Offset(1)
GSpot:
If Target.Count > 1 Then Exit Sub
Set rng = Range("G:G")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Range(Target, Target.Offset(0, -3)).Copy _
Destination:=Sheets("Sheet5").Range("A65536").End(xlUp).Offset(1)

End Sub

 

[rexel12]

Re: Help needed modifying worksheet change vba copy/paste co

Phantom1975, that works perfectly cheers!