Once an active cell value is found, how to select 5 rows above and 20 rows below - excel

Question

I have been helped with other problems, but this is a new one, when a cell has the data value 4, I need to select 5 rows above that, and 20 rows below that and cut / copy that data to another sheet. I have everything else sorted, just this cut above and below the data point.

Answer 1

Copy Rows
Sub RowsCopy()
Const cSource As Variant = "Sheet1" ' Source Worksheet Name/Index
Const cTarget As Variant = "Sheet2" ' Target Worksheet Name/Index
Const cRange As String = "A7" ' Source Cell Range Address
Const cCrit As Long = 4 ' Criteria
Const cRowsA As Long = 5 ' Source Rows Above
Const cRowsB As Long = 20 ' Source Rows Below
Dim ws As Worksheet ' Target Worksheet
Dim FER As Long ' Target First Empty Row
' In Source Cell Range
With ThisWorkbook.Worksheets(cSource).Range(cRange)
' Create a reference to Target Worksheet.
Set ws = .Parent.Parent.Worksheets(cTarget)
' Calculate Target First Empty Row using column 1 (A).
FER = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
' Check if value in Source Cell Range meets (is equal to) Criteria.
If .Value = cCrit Then
' Calculate Target Range Above.
' Calculate Source Range Above.
' Copy values of Source Range Above to Target Range Above.
ws.Rows(FER).Resize(cRowsA).Value _
= .Worksheet.Rows(.Row - cRowsA).Resize(cRowsA).Value
' Calculate new Target First Empty Row by adding Source Rows Above.
FER = FER + cRowsA
' Calculate Target Range Below.
' Calculate Source Range Below.
' Copy values of Source Range Below to Target Range Below.
ws.Rows(FER).Resize(cRowsB).Value _
= .Worksheet.Rows(.Row + 1).Resize(cRowsB).Value
End If
End With
End Sub
Sheet1
Sheet2
Copy and Delete Rows
Sub RowsCopyDelete()
Const cSource As Variant = "Sheet1" ' Source Worksheet Name/Index
Const cTarget As Variant = "Sheet2" ' Target Worksheet Name/Index
Const cRange As String = "A7" ' Source Cell Range Address
Const cCrit As Long = 4 ' Criteria
Const cRowsA As Long = 5 ' Source Rows Above
Const cRowsB As Long = 20 ' Source Rows Below
Dim ws As Worksheet ' Target Worksheet
Dim rng As Range ' Delete Range
Dim FER As Long ' Target First Empty Row
' In Source Cell Range
With ThisWorkbook.Worksheets(cSource).Range(cRange)
' Create a reference to Target Worksheet.
Set ws = .Parent.Parent.Worksheets(cTarget)
' Calculate Target First Empty Row using column 1 (A).
FER = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
' Check if value in Source Cell Range meets (is equal to) Criteria.
If .Value = cCrit Then
' Calculate Target Range Above.
' Calculate Source Range Above.
' Create a reference to Target Range Above (Delete Range).
Set rng = .Worksheet.Rows(.Row - cRowsA).Resize(cRowsA)
' Copy values of Source Range Above to Target Range.
ws.Rows(FER).Resize(cRowsA).Value = rng.Value
' Calculate new Target First Empty Row by adding Source Rows Above.
FER = FER + cRowsA
' Calculate Target Range Below.
' Calculate Source Range Below.
' Add Target Range Below to Delete Range.
Set rng = Union(rng, .Worksheet.Rows(.Row + 1).Resize(cRowsB))
' Copy values of Source Range Below to Target Range Below.
ws.Rows(FER).Resize(cRowsB).Value _
= .Worksheet.Rows(.Row + 1).Resize(cRowsB).Value
' Delete Source Rows
rng.Rows.Delete ' .Hidden = True, .ClearContents, .Clear
End If
End With
End Sub

Answer 2

Small demo:
Option Explicit
Const NEGOFFSET = 5
Const POSOFFSET = 20
Sub test()
Dim r As Range
Set r = Range("a6") 'Assuming A6 is the target cell
r.Select 'Just to show the selected range this far
Set r = r.Offset(-NEGOFFSET, 0).Resize(NEGOFFSET + 1, 1)
r.Select 'Just to show the selected range this far
Set r = r.Resize(POSOFFSET + NEGOFFSET + r.Row, 1)
r.Select 'Just to show the selected range
'*
'* Here r holds the wanted range. Handle it
'*
End Sub