Help with vba to activate on input of cell

[A Thayuman]

Hi I hope that I can be helped with using activate on input cell

'Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Traget, Range("A2:D2")) Is Nothing Then

Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.UnMerge
Range("A2").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

ActiveSheet.Paste

Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.Merge

End If

End Sub

The current macro as see below works fine without adding this feature however when I use the above and when it is in module 1
Sub test()
'Copy Invoice Number to Data Sheet

Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.UnMerge
Range("A2").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

ActiveSheet.Paste

Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.Merge
End Sub

Mr.xlsm
	A	B	C	D	E	F	G	H
1	Customer ID				Customer Name
2	126				Jack Garret
Sheet1

Mr.xlsm
	A	B
1	Customer ID	Customer Name
2	123	Jack Garret
3	123
4	123
Sheet2

 

[A Thayuman]

even with this I am learning so much thanks a million

 

[Skyybot]

Try this code in Sheet1 and see if it works for you.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.UnMerge
Range("A2").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.Merge
End If

End Sub

 

[A Thayuman]

Hi Skybolt the code is the same as one sent on

 

[A Thayuman]

The code now takes me to Sheet2, please see image below, thanks again

 

[Skyybot]

The code now takes me to Sheet2, please see image below

Code stops on that line?

 

[A Thayuman]

Hi Skybolt thanks for your help - I have managed to stumble into this code after trying for the whole day, it works
Is there a way to make it better


Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.UnMerge
Range("A2").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Range("A1").Activate

Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.Merge
End Sub

 

[A Thayuman]

There is a drawback in the code - if cell "A2" is not filled then the there is a debug message, the cursor goes down to the last row in the column

 

[Skyybot]

There is a drawback in the code - if cell "A2" is not filled then the there is a debug message, the cursor goes down to the last row in the column

We have made so many changes. Which code are you using?

 

[A Thayuman]

We have made so many changes. Which code are you using?

Hi Skybolt the code that works is shown below - however we need to have A2 filled with information, if it is blank the code goes right down to the the bottom of the sheet in coloum "A". Thanks as always for your offer to help


Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.UnMerge
Range("A2").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Range("A1").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.Merge
End Sub

 

[A Thayuman]

Hi Skybolt the code that works is shown below - however we need to have A2 filled with information, if it is blank the code goes right down to the the bottom of the sheet in coloum "A". Thanks as always for your offer to help.
It started working when the code to Activate the Sheet and range was added
Sheets("Sheet2").Select
Sheets("Sheet2").Range("A1").Activate

The code that works is:

Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.UnMerge
Range("A2").Select
Selection.Copy
Sheets("Sheet2").Select
Sheets("Sheet2").Range("A1").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("A2:D2").Select
Selection.Merge
End Sub