在复制期间更改公式引用
我有一个工作表，其中包含35列公式从其他工作表中查找数据。 每次数据input到查找工作表（“数据”）我想添加另一套公式的行底部。 我已经设法让代码复制这35列的正确的公式，到底部的正确位置。 但是当他们粘贴时，公式的确切文本被复制，而不是改变引用的单元格。
例如从行7736复制到行8300中的公式“= OFFSET（Data！$ B $ 1，（A7736-1）* 34,0）”应该变为= OFFSET（Data！$ B $ 1，（A8300-1）* 34,0 ）但保持为“= OFFSET（Data！$ B $ 1，（A7736-1）* 34,0）”
这是我的代码
Dim workbk As Workbook Dim databk As Workbook Dim MRD As Worksheet Dim formularrange As Range Dim lasttrayname As String Dim datarow As Long Dim nrow As Long Dim loopcount As Long Dim urow As Long Set workbk = ActiveWorkbook 'set Macro recording information sheet Set MRD = Worksheets("Macro RunDate") 'find last date updated urow = Worksheets("Macro RunDate").Range("A" & Rows.Count).End(xlUp).Row 'find last tray used lasttray = MRD.Range("B" & urow).Value 'find row to paste raw tray data datarow = Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row Do while *condition* '...More code here.... Loopcount = 0 Loopcount = loopcount + 34 Loop Go to Tidy: Tidy: If loopcount > 0 Then 'convert to correct number of rows to copy loopcount = (loopcount)/34*8 'copy formulas in Sheet2 for correct number of trays 'determine end row by finding "lasttray" nrow = Worksheets("Sheet2").Range("A:A").Find(What:=lasttray, _ SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlNext).Row + 8 'repeat formulas Worksheets("Sheet2").Range(Cells(nrow + 1, "A"), Cells(nrow + loopcount + 1, _ "S")).Formula = Worksheets("Sheet2").Range("A3975:s" & 3975 + loopcount).Formula 'calculate formula values Worksheets("Sheet2").Range("A:E").Calculate End If 所以我的问题是，我如何复制这些公式，并得到参考改变？
提前致谢
而不是设置公式属性，您可以使用复制：
Dim Source As Range Dim Dest As Range Set Source = Worksheets("Sheet2").Range("A3975:s" & 3975 + loopcount) Set Dest = Worksheets("Sheet2").Range(Cells(nrow + 1, "A"), Cells(nrow + loopcount + 1, _ "S")) Source.Copy Dest
然后，Excel会像手动复制时一样增加行号。
而不是使用cell1 = cell2，请执行以下操作：
Range(cell1).Select Application.CutCopyMode = False Selection.Copy Range(cell2).Select ActiveSheet.Paste
应该粘贴相关公式。