Clearing Contents

Question

I'm using the following code listed below. I works fine, but It wipes out the formula in one of my cells. How do I modify this code to skip one cell in my sheet?

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Data").UsedRange.Rows.count
J = Worksheets("Completed").UsedRange.Rows.count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Data").Range("A1:A" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.count
If CStr(xRg(K).Value) = "Completed" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & J + 1)

xRg(K).EntireRow.ClearContents

J = J + 1
End If
Next
Application.ScreenUpdating = True
Columns("A:A").Select
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("A3:A16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Data").Sort
.SetRange Range("A2:Q16")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Application.Goto Reference:=Worksheets("Data").Range("A3")
End With