Copy entire row above a blank cell?

[mrjimmyvo]

This might be impossible... but here goes..

So I made a code to locate a specific value "ack-", and to copy/paste into another sheet...

Sub HEA_Filter_Dates_Times()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("ack-")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(<wbr>xlUp).Row
DestNoRows = 1
Set wsDest = Sheets("Real Alarms")

For I = 1 To NoRows

Set rngCells = wsSource.Range("B" & I)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J

If Found Then
rngCells.EntireRow.Offset(-1).<wbr>Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next I
End Sub



Now I need it to locate "Ack-" and then copy the nearest row above two empty rows... and paste it into another sheet on column J.

COPY THIS ONE


awdasrgh
asrgharharh
asrharharh
Ack-

Is this impossible??