Удалить строку в цикле for, если соответствует критериям

Я хочу удалить строку после того, как скопирую ее в другое место. Есть много сообщений по этой проблеме; Я не уверен, почему ни один из них не работает в моей конкретной ситуации.

Sub Transition_Queue_to_Other()

Dim QueueSheet As Worksheet
Set QueueSheet = ThisWorkbook.Worksheets("Project Queue")

Dim TableQueue As ListObject
Set TableQueue = QueueSheet.ListObjects("TableQueue")

Dim TransColumn As Range
Set TransColumn = QueueSheet.Range("TableQueue[Transition]")

Dim Trans_Queue_Row As Range
Dim i As Integer

With TransColumn
    For i = 1 To .Count

        If InStr(1, .Rows(i).Value, "NPD") > 0 Then

            Dim NPDSheet As Worksheet
            Set NPDSheet = ThisWorkbook.Worksheets("NPD")

            Dim TableNPD As ListObject
            Set TableNPD = NPDSheet.ListObjects("TableNPD")

            Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
            Set Trans_NPD_Row = TableNPD.ListRows.Add.Range

            Trans_NPD_Row.Cells(, 1).Value = Trans_Queue_Row.Cells(, 2).Value

'Now, how do I delete each Trans_Queue_Row after I've copied the info from it to the Trans_NPD_Row?  I've tried several different ways with no success, including:

'Trans_Queue_Row.Delete

'Trans_Queue_Row.Range.Delete

'Trans_Queue_Row.Select
'Selection.Delete

for-loop vba listobject
person Dave F    schedule 15.07.2019    source источник
comment
При удалении строк всегда идти снизу вверх - For i = .Count to 1 Step -1   -  person PatricK    schedule 15.07.2019
comment
stackoverflow.com/questions/56996550/   -  person Tim Williams    schedule 15.07.2019

Ответы (1)


arrow_upward
1
arrow_downward

Попробуйте этот код:

Sub Transition_Queue_to_Other()

Dim QueueSheet As Worksheet
Set QueueSheet = ThisWorkbook.Worksheets("Project Queue")

Dim TableQueue As ListObject
Set TableQueue = QueueSheet.ListObjects("TableQueue")

Dim TransColumn As Range
Set TransColumn = QueueSheet.Range("TableQueue[Transition]")

Dim Trans_Queue_Row As Range
Dim i As Integer


            Dim NPDSheet As Worksheet
            Set NPDSheet = ThisWorkbook.Worksheets("NPD")

            Dim TableNPD As ListObject
            Set TableNPD = NPDSheet.ListObjects("TableNPD")



With TransColumn
    For i = .Count To 1 Step -1

        If InStr(1, .Rows(i).Value, "NPD") > 0 Then

            Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
            Set Trans_NPD_Row = TableNPD.ListRows.Add.Range

            Trans_NPD_Row.Cells(, 1).Value = Trans_Queue_Row.Cells(, 2).Value

            Trans_Queue_Row.EntireRow.Delete xlShiftUp

        End If
    Next
End With

End Sub

Переход снизу вверх и удаление строки с помощью EntireRow.Delete

person Mikku    schedule 15.07.2019