Question

我有一个现有的VBA代码，可以将源工作簿（Sourcewb）中的Excel工作表复制到新的目标工作簿（Destwb），但只粘贴值。我需要D31:E38中的特定范围（Destwb）来包含源工作簿中的公式。我找到了这段代码：

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

在这个网站上（另一个问题）看似相关但不知道如何修改它以在我的应用程序中工作。我添加了一条注释行“'在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

Answer 1

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

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

Answer 2

您可以像往常一样复制整个事物，然后使用Destwb中的单元格中的公式覆盖D31:E38 Sourcewb中的单元格。假设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

如何使用VBA

2 个答案: