Jag använder följande kod nedan. Jag fungerar bra, men den raderar formeln i en av mina celler. Hur ändrar jag den här koden för att hoppa över en cell i mitt ark?
Sub MoveRowBasedOnCellValue()
'Uppdaterad av Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim jag så länge
Dim J As Long
Dim K As Long
i = Worksheets("Data").UsedRange.Rows.count
J = Arbetsblad("Completed").UsedRange.Rows.count
Om J = 1 då
Om Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("Data").Range("A1:A" & i)
On Error Resume Next
Application.ScreenUpdating = False
För K = 1 Till xRg.count
Om CStr(xRg(K).Value) = "Slutförd" Då
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & J + 1)
xRg(K).EntireRow.ClearContents
J = J + 1
End If
Nästa
Application.ScreenUpdating = True
Kolumner("A:A"). Välj
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("A3:A16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Med ActiveWorkbook.Worksheets("Data").Sort
.SetRange Range("A2:Q16")
.Header = xlJa
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Tillämpa
Application.Goto Reference:=Worksheets("Data").Range("A3")
Sluta med
Sub MoveRowBasedOnCellValue()
'Uppdaterad av Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim jag så länge
Dim J As Long
Dim K As Long
i = Worksheets("Data").UsedRange.Rows.count
J = Arbetsblad("Completed").UsedRange.Rows.count
Om J = 1 då
Om Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Då J = 0
End If
Set xRg = Worksheets("Data").Range("A1:A" & i)
On Error Resume Next
Application.ScreenUpdating = False
För K = 1 Till xRg.count
Om CStr(xRg(K).Value) = "Slutförd" Då
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & J + 1)
xRg(K).EntireRow.ClearContents
J = J + 1
End If
Nästa
Application.ScreenUpdating = True
Kolumner("A:A"). Välj
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("A3:A16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Med ActiveWorkbook.Worksheets("Data").Sort
.SetRange Range("A2:Q16")
.Header = xlJa
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Tillämpa
Application.Goto Reference:=Worksheets("Data").Range("A3")
Sluta med