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:
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:
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
You can try with: ActiveSheet.PasteSpecial Paste:=xlFormulas
ActiveSheet.Unprotect
...
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells.PasteSpecial xlFormulas
.Cells(1).Select
End With
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:
'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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.