问题描述
我有一个现有的VBA代码,将源工作簿( Sourcewb
)中的Excel工作表复制到新的目标工作簿中( Destwb
),但仅粘贴值。我需要 Destwb
中的特定范围( D31:E38
),以包含源工作簿中的公式。我发现这个代码: 范围(A1:I1105)复制表(Sheet2)范围)
在这个网站(另一个问题)似乎相关但不知道如何修改它在我的申请中工作我添加了一个注释行'在Calc表中插入总计数,在这里我认为附加的代码将会去。这是我现有的代码:
Set Sourcewb = ActiveWorkbook
'将工作表复制到新的工作簿
表格(计算)复制
设置Destwb = ActiveWorkbook
'确定Excel版本和文件扩展名/格式
使用Destwb
如果Val (Application.Version) 12然后
'您使用Excel 97-2003
FileExtStr =.xls:FileFormatNum = -4143
Else
'您使用Excel 2007-2013
FileExtStr = .xlsx:FileFormatNum = 51
End If
End With
'如果您想要
,将工作表中的所有单元格更改为值使用Destwb.Sheets(1 ).UsedRange
Application.CutCopyMode = False
ActiveSheet.Unprotect
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1)。选择
结束
Application.CutCopyMode = False
'在Calc表中插入总计数
'保存新工作簿并关闭
TempFilePath = (Calculation)。Range(L4)。value
TempFileName = Range(L3)。value
With Destwb
.SaveAs TempFilePath& \& TempFileName& FileExtStr,FileFormat:= FileFormatNum
.Close SaveChanges:= True
结束
MsgBox您可以在& TempFilePath
在 Destwb
D31:E38
中使用 Sourcewb 。假设 Sourcewb
中的兴趣范围是 D31:E38
,目标范围和源范围是相同的你可以执行以下操作:
'复制所有单元格
'您的代码在这里
'新的代码
set formulaRngFromSource = Sourcewb.Sheets(Calculation)。Range(D31:E38)
set formulaRngToDest = Destwb.Sheets(1).Range(D31:E38 )
i = 1
在formulaRngFromSource中的每个范围
formulaRngToDest(i).Formula = range.Formula
i = i + 1
next range
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 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
这篇关于如何复制然后使用VBA将公式从一个工作簿粘贴到另一个工作簿的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!