Question

我正在根据要检查的复选框链接复制信息列。一切都有效，除了包含公式的几行。我需要复制实际的公式，换句话说，我不希望公式根据它复制到的位置更改它的单元格引用。我尝试添加一行来重新复制带有公式的几行，但无法使其工作。（我在代码中添加了一条注释，以显示我收到错误的位置。）

在A栏中，始终有文本“EE Only”，我将其定义为TextToFind。需要复制的公式将从该行开始减1，并且总共为5行。因此，如果“EE Only”在第22行，那么我需要复制第21行到第25行。

我在这里尝试做的是继续使用我的代码，然后使用实际公式第二次复制公式行。

    'Called from AddWorksheet
Sub CopyFinal(orgSheet As Worksheet, destSheet As Worksheet)

Const TextToFind As String = "EE Only"
Dim ws As Worksheet
Dim RowNum As Range
Set ws = ActiveSheet
Dim J As Integer
Dim lastColumn As Long
Dim benRow As Long

J = 2
lastColumn = 2
'Counts the number of benefits on each sheet.  Assumes that they will not go past row 40
benRow = WorksheetFunction.CountA(orgSheet.Range("B3:B40"))

Application.ScreenUpdating = False

Do Until IsEmpty(orgSheet.Cells(3, J))
Set RowNum = orgSheet.Range("A:A").Find(what:=TextToFind, lookat:=xlWhole)
    If orgSheet.Cells(80, J) = True Then
        orgSheet.Columns(1).Copy destSheet.Columns(1)
        orgSheet.Cells(3, J).Resize(benRow).Copy
        With destSheet.Cells(3, lastColumn)
            .PasteSpecial Paste:=xlPasteAll
            .PasteSpecial Paste:=xlPasteColumnWidths
            Range("A1").Select
        End With
        '**The line below is giving an error
        orgSheet.Cells(RowNum, J).Resize(4).Formula = destSheet.Cells(RowNum, lastColumn).Formula

    End If
    J = J + 1
    lastColumn = destSheet.UsedRange.Columns(destSheet.UsedRange.Columns.Count).Column + 1
Loop

orgSheet.Rows(1).Copy destSheet.Rows(1)
Range("D1").ColumnWidth = 26.14

Call AddShapes

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

复制公式而不更改单元格引用

0 个答案: