Auto paste values two different cells in same column (last cell)

[elsg]

How get values ​​of two cells and paste in the same column?

i need get value whne enter in M4 and paste (last cells in column S) S4, case enter value in M5 paste (last cells in column S) S5

in so on

I try it..but doen's work

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Cells.Count > 1 Then Exit Sub


        If Not Intersect(Target, Range("M4:M5")) Is Nothing Then


            With Target(0, 6).Offset(1)
                .Value = Target.Value
                .EntireColumn.AutoFit
            End With


        End If


End Sub

 

[ParamRay]

.
.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim WRng As Range
    Dim Cell As Range
    
    On Error Resume Next
        Set WRng = Intersect(Target, Me.Range("M4:M5"))
    On Error GoTo 0
    
    If Not WRng Is Nothing Then
        Application.EnableEvents = False
        For Each Cell In WRng
            With Cell.Offset(0, 6)
                .Value = Cell.Value
                .EntireColumn.AutoFit
            End With
        Next Cell
        Application.EnableEvents = True
    End If

End Sub

 

[elsg]

Soory, but not it

when entering a value in M4 or M5 paste S4 (all that enter a value in M4 or M5 values ​​will be pasted in (S4, S5, S6 .... S10000)), i need paste below last row column S

 

[ParamRay]

.
.

Change this line...

From:

Set WRng = Intersect(Target, Me.Range("M4:M5"))

To:

Set WRng = Intersect(Target, Me.Columns("M"))

 

[elsg]

sorry, nothing happening

Imagine whne you enter in M4 or M5, value go to columns S

45
525
1005
1485
1965
2445
2925
3405
3885
4365
4845
5325
5805
6285
6765
7245
7725

<colgroup><col></colgroup><tbody>
</tbody>

 

[elsg]

Bump!

 

[elsg]

would look like this, but within the private Worksheet_Change

Sub Test()    Dim LR As Long
    LR = Cells(Rows.Count, 19).End(xlUp).Row
    Application.ScreenUpdating = False
    With Sheets("Plan1")
        .Range("M4:M5").Copy .Range("S5:S" & LR)
        .Range("M4:M5").ClearContents
    End With
    Application.ScreenUpdating = True
End Sub

 

[elsg]

i need only one code, i prefer use Worksheet_Change

[/B]Private Sub Worksheet_Change(ByVal Target As Range)  Application.EnableEvents = False
   Application.ScreenUpdating = False
    If Not Application.Intersect(Target, Range("M4:M5")) Is Nothing Then
            Call Code_Two
    Else: Exit Sub
    End If
    Application.EnableEvents = True
   Application.ScreenUpdating = True

End Sub[B]

[/B]Sub Code_Two()

  Dim i, LastRow
  LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 4 To 5
        If Cells(i, "M").Value <> "" Then
            Cells(i, "M").Copy
            Range("S" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            Cells(i, "M").ClearContents
        End If
    Next
  Application.CutCopyMode = False



End Sub[B]

 

[elsg]

i want someone help me.

thank you!!