如何使用VBA将公式从一个工作簿复制粘贴到另一个工作簿

I have an existing VBA code that copies an Excel worksheet from my source workbook (Sourcewb) into a new destination workbook (Destwb) but pastes values only. I need a specific range (D31:E38) in the Destwb to include the formulas from the source workbook. I found this code:

我有一个现有的VBA代码,它将Excel工作表从我的源工作簿(Sourcewb)复制到新的目标工作簿(Destwb),但仅粘贴值。我需要在Destwb中使用特定范围(D31:E38)来包含源工作簿中的公式。我找到了这段代码:

Range("A1:I1105").Copy Sheets("Sheet2").Range("B2")

On this site (another question) that seems related but don't know how to modify it to work in my application. I have added a comment line " 'Insert total formulas in Calc sheet" for where I think the additional code would go. Here is my existing code:

在这个网站(另一个问题)似乎相关但不知道如何修改它在我的应用程序中工作。我添加了一条注释行“'在Calc表中插入总公式”,我认为附加代码会去。这是我现有的代码:

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
Sheets("Calculation").Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2013
            FileExtStr = ".xlsx": FileFormatNum = 51
        End If
End With

'Change all cells in the worksheet to values if you want
With Destwb.Sheets(1).UsedRange
    Application.CutCopyMode = False
    ActiveSheet.Unprotect
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
End With
Application.CutCopyMode = False

'Insert total formulas in Calc sheet

'Save the new workbook and close it
TempFilePath = Sheets("Calculation").Range("L4").Value
TempFileName = Range("L3").Value

With Destwb
    .SaveAs TempFilePath & "\" & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    .Close SaveChanges:=True
End With

MsgBox "You can find the new file in " & TempFilePath

2 个解决方案

#1

You could copy the whole thing first, like you are doing and then overwrite the cells in Destwb D31:E38 with the formulas from the cells in Sourcewb. Assuming the range of interest in Sourcewb is "D31:E38" and that the destination range and source range are the same size, you could do the following:

你可以像往常一样复制整个事物,然后使用Sourcewb中单元格中的公式覆盖Destwb D31:E38中的单元格。假设Sourcewb中感兴趣的范围是“D31:E38”,并且目标范围和源范围大小相同,则可以执行以下操作:

'Copy all cells
'Your code here

'New code
set formulaRngFromSource = Sourcewb.Sheets("Calculation").Range("D31:E38")
set formulaRngToDest = Destwb.Sheets(1).Range("D31:E38")

i = 1
for each range in formulaRngFromSource
     formulaRngToDest(i).Formula = range.Formula
     i = i + 1
next range

#2

You can try with: ActiveSheet.PasteSpecial Paste:=xlFormulas

您可以尝试使用:ActiveSheet.PasteSpecial Paste:= xlFormulas

ActiveSheet.Unprotect
...
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
    .Cells.PasteSpecial xlFormulas
    .Cells(1).Select
End With