Copy the below and paste it one cell up

[shobii]

Please see the attached image too. I want to copy the values one cell up to the last row. https://imgur.com/TQQplI7



Sub test2()
Dim rOriginalSelection As Range

Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Select Case direction
Case up
Set rOriginalSelection = Range("J11" & lrow)
Case Else
Debug.Assert False
End Select


With rOriginalSelection
.Select
.Cut
Select Case direction
Case "up"
.Offset(-1, 0).Select
End Select
End With
Selection.Insert
rOriginalSelection.Select


Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True


End Sub

 

[shobii]

I keep getting run time error for copy pasting size problem.