Cut and paste a range of cells if criteria met

[cwills]

Hi,
I currently use the following code to cut and paste an entire row from one sheet to another based upon a cell meeting the criteria

Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
I = Worksheets("Work Split").UsedRange.Rows.Count
J = Worksheets("Allocation").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Allocation").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Work Split").Range("D1:D" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "allocate" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Allocation").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Allocate" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True

However, This moves the whole row, what do I change to move only cells A:H if the criteria is met?

(also, using the above code pastes the data into the next row of cells in the target sheet that have never been used, even if they are currently blank, anyone know why and how to paste in the first available row?)

Thank you
Col.