Использование Excel Macro / VBA для вырезания и вставки данных во вновь созданную строку

Question

Я хочу иметь возможность изменять текущий отчет, который я работаю для своей компании.Отчет возвращает некоторую основную информацию о событии.В конце данных есть один последний столбец, который содержит описание события.Я хочу вставить новую строку над любой строкой, содержащей «Итоги», а затем вставить описание потери: Описание.

Проблема, с которой я сталкиваюсь, заключается в том, что я не могу заставить «Описания» вырезать и вставлятьпозади потери Описание: во вновь созданном ряду.Я не могу опубликовать изображение отчета, но код, который я использую, будет ниже.Когда я запускаю макрос, над строкой создается новая строка, которая содержит «Итоги», но столбец с описанием не вырезается и не вставляется.Описание приведено в столбце Q электронной таблицы Excel, а описание потери: создается в столбце A.

   Sub InsertAdj()
    Dim LR As Long, i As Integer, n As Integer
    LR = Cells(Rows.Count, "A").End(xlUp).Row
    For i = LR To 2 Step -1
    If Left(Range("A" & i), 6) = "Totals" Then
    Rows(i).Insert Shift:=xlDown
    n = WorksheetFunction.Match(WorksheetFunction.Lookup("zzzzz", Range("A1:A" & i)), Range("A1:A" & i), 
    0)
    Cells(i, 1) = "Loss Description: " & Cells(n + 1, 16).Value
    Cells(n + 1, 16).ClearContents
    End If
    Next i
    End Sub

Answer 1

На вашем рабочем листе происходит что-то странное, когда End(xlUp) не ведет себя должным образом - по какой-то причине он останавливается на пустых ячейках ...

Протестировал этот альтернативный подход, и он работает для меня наваш образец листа:

Sub InsertAdj()
    Dim LR As Long, i As Integer, n As Integer, descCell As Range
    Dim sht As Worksheet

    Set sht = ActiveSheet
    LR = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

    For i = LR To 2 Step -1
        If Left(sht.Range("A" & i), 6) = "Totals" Then
            sht.Rows(i).Insert Shift:=xlDown

            'end(xlUp) does not work for some reason, so call a function to find the description
            Set descCell = FindDescriptionCell(sht.Cells(i + 1, "Q")) 'call function

            sht.Cells(i, 1) = "Loss Description: " & descCell.Value
            descCell.ClearContents
        End If
    Next i
End Sub

Function FindDescriptionCell(c As Range)
    Dim f
    'search up for a value
    Set f = c.EntireColumn.Find(what:="*", after:=c, _
             searchorder:=xlByColumns, searchdirection:=xlPrevious)
    If Not f Is Nothing Then
        'ensure Find didn't loop back below the start cell
        If f.Row < c.Row Then Set FindDescriptionCell = f
    End If
End Function