Excel VBA: Sort, then copy and paste

All I need to write a macro that does the following:

  • When entering data in the last empty cell in column E, sort the entire sheet by column E in descending order

  • After sorting the worksheet:

    2a. Copy the cell to the adjacent cell directly in the left of the cell into which the data was entered.

2b. Paste the copied data into the first column of the same row from which the data was originally entered

     

2c. Move the cursor to a neighboring cell directly to the right of the cell into which the data was entered

Below I show sorting by input code, which works. However, I cannot then get the code to copy, paste and move. My most common problem: after entering data, the lines move, but the cursor remains in the line where the data was first entered. Can anyone help? (I can't even get indented on this post!)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) Is Nothing) Then
        DoSort
    End If
End Sub

Private Sub DoSort()
    Worksheets("Sheet1").Range("A:E").Sort Key1:=Worksheets("Sheet1").Range("E1"), Order1:=xlDescending, Header:=xlYes
End Sub
+3
source share
2 answers

Regarding 1, 2a and 2b: it’s easier to do a copy before sorting. Thus, the copied value will be sorted along with the rest.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
        Is Nothing) Then
        ' First copy
        Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
        ' Then sort
        DoSort
    End If
End Sub

This leaves the question (2c) about how to move the active cell to the corresponding row after sorting the rows. Presumably you want the user to enter additional data in column F?

, , . , , E F. , .

, , 2c. , , . Excel Sort , . / " " . :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim newIndex As Long
    If Not (Application.Intersect(Worksheets("Sheet1").Range("E:E"), Target) _
        Is Nothing) Then
        ' Index the new entry in column B. (You can put the index elsewhere.)
        newIndex = WorksheetFunction.Max(Range("B:B")) + 1
        Target.Offset(0, -3).Value = newIndex
        ' Copy the entry.
        Target.Offset(0, -1).Copy Destination:=Target.Offset(0, -4)
        ' Sort
        DoSort
        ' Search for the new index after sorting. Select cell in column 6 (F).
        Cells(WorksheetFunction.Match(newIndex, Range("B:B"), 0), 6).Select
    End If
End Sub

, (.. ); . , , ( ) , . .

+3

.

, E, , .

, (), , , , E ( , ), .

( Excel VBA, ). , .

( E), , offset . , , .

, :)

Rgds

0

All Articles