Примерно так должно работать:
Sub Tester()
ShiftUp Range("B4:C13"), 3
End Sub
Sub ShiftUp(rng As Range, numRows As Long)
Dim tmp
With rng
tmp = .Rows(1).Resize(numRows).Value
.Rows(1).Resize(.Rows.Count - numRows).Value = _
.Rows(numRows + 1).Resize(.Rows.Count - numRows).Value
.Rows((.Rows.Count - numRows) + 1).Resize(numRows).Value = tmp
End With
End Sub
Как UDF:
Function ShiftUp(rng As Range, numRows As Long)
Dim d, dOut, r As Long, c As Long, rMod As Long, rTot As Long
Dim break As Long
d = rng.Value
dOut = rng.Value 'as a shortcut to creating an empty array....
rTot = UBound(d, 1)
break = rTot - numRows
For r = 1 To rTot
For c = 1 To UBound(d, 2)
'figure out which input row to use...
rMod = IIf(r <= break, r + numRows, -(break - r))
dOut(r, c) = d(rMod, c)
Next c
Next r
ShiftUp = dOut
End Function
Обратите внимание, что это формула массива, поэтому вам нужно будет выбрать диапазон того же размера, что и диапазон ввода, и ввести формулу, используя Ctrl Shift Enter