Код VBA для перемещения завершенных строк на другой лист вызывает странное поведение - PullRequest
0 голосов
/ 10 января 2020

Отказ от ответственности: я не разбираюсь в VBA и собрал следующий код, читая различные блоги, и т. Д. c.

Мой код «работает» в том смысле, что он перемещает строки, статус которых изменен Готово с Активного листа на Завершенный лист. Это была точка кода.

Проблема возникает, когда я использую кнопку перетаскивания (маленький черный угловой элемент), чтобы создать еще одну строку на исходном листе (активный лист). По какой-то причине он копирует строку заголовка с Активного листа в новую строку на Завершенном листе.

Это должно быть связано с действием копирования и вставки, но я не уверен, как это связано с перетаскиванием таблица для создания строки (если вообще). Любая помощь или руководство для этого любителя VBA будет высоко ценится.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    'If Cell that is edited is in column H and the value is Done
    If Target.Column = 8 And Target.Value = "Done" Then
        'Define last row on completed worksheet to know where to place the row of data
        LrowCompleted = Sheets("Completed").Cells(Rows.Count, "B").End(xlUp).Row
        'Copy and paste data
        Range("B" & Target.Row & ":K" & Target.Row).Copy Sheets("Completed").Range("B" & LrowCompleted + 1)
        'Delete Row from Project List
        Range("B" & Target.Row & ":K" & Target.Row).Delete xlShiftUp
    End If
    Application.EnableEvents = True
End Sub

1 Ответ

0 голосов
/ 10 января 2020

On Error Resume Next скрывает потенциальные ошибки. Например, Target.Value = "Done" выдаст ошибку, если Target - это диапазон из нескольких ячеек.

Возможно, попробуйте следующее:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 8 Then Exit Sub
    If Target.CountLarge <> 1 Then Exit Sub

    On Error GoTo SafeExit
    Application.EnableEvents = False
    If Target.Value = "Done" Then
        Dim LrowCompleted as Long
        LrowCompleted = Sheets("Completed").Cells(Rows.Count, "B").End(xlUp).Row

        Me.Range("B" & Target.Row & ":K" & Target.Row).Copy ThisWorkbook.Sheets("Completed").Range("B" & LrowCompleted + 1)

        Me.Range("B" & Target.Row & ":K" & Target.Row).Delete xlShiftUp
    End If

SafeExit:
    Application.EnableEvents = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...