Копировать вставить строку без увеличения ссылок на формулы

Question

Я пытаюсь создать макрос с VBA, который находит указанную строку и вставляет новую строку под каждой строкой, содержащей такую ​​строку. Это работает (в основном), но каждый раз, когда формулы копируются в новую строку, ссылки (на другой рабочий лист) увеличиваются на 1. К сожалению, из-за характера рабочего листа я не могу использовать stati c ссылки с $.

Итак, мой вопрос: как я могу, используя VBA, предотвратить автоинкремент ссылок в формулах при вставке ранее существовавшей строки?

Заранее спасибо :)

If InStr(1, xRng.Cells(i, 1).Value, previousName) > 0 Then
        Rows(xRng.Cells(i, 1).Row).Copy
        Rows(xRng.Cells(i, 1).Row + 1).Insert CopyOrigin:=xlFormatFromRightOrBelow 
        xRng.Cells(i + 1, 1).Value = name
        Worksheets(inWorksheet).Range("B1").Value = name
        Rows(xRng.Cells(i + 1, 1).Row).Replace What:=oldWorksheet, Replacement:=inWorksheet
End If

Answer 1

Вместо того, чтобы использовать Копирование, вы можете Insert создать новую строку, а затем вручную изменить .Formula / .Value каждой ячейки:

Function DuplicateRow(TargetRow AS Long, Optional ws AS Worksheet) AS Boolean
    If ws Is Nothing Then Set ws = ActiveSheet

    DuplicateRow = False    
    If TargetRow >= ws.Rows.Count Then Exit Function

    ws.Rows(TargetRow+1).Insert

    Dim CurrentCell AS Range

    For Each CurrentCell In Intersect(ws.Rows(TargetRow),ws.UsedRange.EntireColumn)
        If CurrentCell.HasFormula Then
            CurrentCell.Offset(1,0).Formula = CurrentCell.Formula
        ElseIf Len(CurrentCell.Value) > 0 Then
            CurrentCell.Offset(1,0).Value = CurrentCell.Value
        End If
    Next CurrentCell

    DuplicateRow = True
End Function

Это сделает ваш код

If InStr(1, xRng.Cells(i, 1).Value, previousName) > 0 Then
    DuplicateRow xRng.Cells(i, 1).Row, xRng.Worksheet
    xRng.Cells(i + 1, 1).Value = name
    Worksheets(inWorksheet).Range("B1").Value = name
    Rows(xRng.Cells(i + 1, 1).Row).Replace What:=oldWorksheet, Replacement:=inWorksheet
End If

В зависимости от того, сколько столбцов у вас есть, это может быть медленнее, чем ваш существующий Копировать / Вставить