User selects row, then move data in certain cells from selected row to certain cells in the row above

[Don4000]

Hello Everyone

I wonder if someone could help with a problem I have been presented with

Could someone design a macro, that for the row that has been selected by the user, cuts data in certain cells of that row, and pastes the data into specific cells in the row above, as per the schedule below

Selected row Row above selected row

V T

W S

X Q

Y R



Eg

V22 is cut and pasted into T21

W22 is cut and pasted into S21

Etc


Once this has been completed, the selected row is deleted

I would be very grateful, for anyone’s help



Thank you

Don4000

 

[Sektor]

If I select Y column, how do I know that I need to move data into R row? Is this logic hard-coded? Or there's some structure of the sheet that implies it?

 

[Alex Blakenburg]

Let's start with this:

Sub CopyDataDeleteRow()

    Dim ws As Worksheet
    Dim currRow As Long
    
    Set ws = ActiveSheet                    ' <--- Idealy change to named sheet using Worksheets("NameOfSheet")
    
    If Selection.Rows.Count > 1 Then
        MsgBox "Multiple rows selected exiting procedure"
        Exit Sub
    End If
    
    currRow = Selection.Row
    
    With ws
        .Range("T" & currRow - 1).Value = .Range("V" & currRow).Value
        .Range("S" & currRow - 1).Value = .Range("W" & currRow).Value
        .Range("Q" & currRow - 1).Value = .Range("X" & currRow).Value
        .Range("R" & currRow - 1).Value = .Range("Y" & currRow).Value
        
        .Rows(currRow).Delete
    End With
End Sub

 

[Don4000]

Alex, this works beautifully, and will help enormously
Thank you very much for helping
The skill and expertise here is just wonderful
Also a thank you to everyone who viewed the post
Happy New Year everyone

Don

 

[Alex Blakenburg]

You're welcome. Thank you for the feedback and Happy New Year too you too.

 

[jolivanes]

Another possibility without taking anything away from Alex's suggestion.
For multirow selection error you can copy Alex's error check.

Sub With_Array()
Dim ocArr, ncArr, nr As Long, i As Long
ocArr = Array(22, 23, 24, 25)
ncArr = Array(20, 19, 17, 18)
nr = Selection.Row - 1
    For i = LBound(ncArr) To UBound(ncArr)
        Cells(nr, ncArr(i)).Value = Cells(nr + 1, ocArr(i)).Value
    Next i
Rows(nr + 1).Delete
End Sub

Happy, Healthy and Prosperous New Year to all of you and yours.