VBA复制粘贴工作簿相同的工作表之间，通过对话框打开

我已经看到了这个问题的答案，是我正在寻找的变化，但是当我试图修改代码到我的情况，我不断收到错误消息。

我有两本练习册，一本硕士“模板”和一份名为“YTDJune2015”的月度报告。 每个都有15张，两者都是相同的，我想将月度报告中的数据复制到模板中，该模板具有计算15个独特表格中每一个的附加数据的公式。 我想使用“打开”对话框作为select源工作簿的方式，因为报表每月更新一次。 在打开对话框中select源文档后，我不断收到“对象需要”错误，无法弄清楚如何允许它打开源工作簿。 代码的范围部分也可能不正确，但是我还没有能够通过源文档的开始，所以我不能检查它。 我希望它遍历源工作簿中的每个工作表并复制相同的范围，然后粘贴到目标工作簿中。 到目前为止，我拥有的代码是：

Sub UpdateWorkbook() Dim wbSource As Workbook, wbDest As Workbook Dim ws As Worksheet, rng As Range Application.ScreenUpdating = False Set wbSource = Application.GetOpenFilename(FileFilter:="Excel Filter (*.xlsx), *.Xlsx", Title:="Open File(s)", MultiSelect:=False) Set wbDest = Workbooks.Open("Template.xlsm") For Each ws In wbSource.Sheets For Each rng In ws.Range("C8:AB117").Areas wbDest.Sheets(ws.Name).Range(rng.Address).Value = rng.Value Next rng Next ws wbSource.Close SaveChanges:=False Application.ScreenUpdating = True End Sub 

Answer 1

上面的评论是正确的关于GetOpenFilename ，它不返回一个Workbook对象，它返回的string是您select的文件的path，因此“对象需要”。

为了解决这个问题，我build议调暗一个string来包含文件名，然后将工作簿对象设置为新的variables名，如注释中所示。

我想添加的是最后一部分，你可以在代码中使用粘贴特殊值：

 Sub UpdateWorkbook() Dim wbSource As Workbook, wbDest As Workbook Dim ws As Worksheet, rng As Range Dim sFile as String Application.ScreenUpdating = False sFile = Application.GetOpenFilename(FileFilter:="Excel Filter (*.xlsx), *.Xlsx", Title:="Open File(s)", MultiSelect:=False) Set wbSource = Workbooks.Open(sFile) Set wbDest = Workbooks.Open("Template.xlsm") For Each ws In wbSource.Sheets For Each rng In ws.Range("C8:AB117").Areas rng.copy wbDest.Sheets(ws.Name).Range(rng.Address).PasteSpecial xlPasteValues Next rng Next ws Application.CutCopyMode = False wbSource.Close SaveChanges:=False Application.ScreenUpdating = True End Sub 

但是，您可能希望将xlPasteValues更改为xlPasteValuesAndNumberFormats

Answer 2

未经testing。

 Sub UpdateWorkbook() Dim wbSource As Workbook, wbDest As Workbook Dim ws As Worksheet, rng As Range Dim sFile As String Application.ScreenUpdating = False sFile = Application.GetOpenFilename(FileFilter:="Excel Filter (*.xlsx), *.Xlsx", Title:="Open File(s)", MultiSelect:=False) Set wbSource = Workbooks.Open(sFile) Set wbDest = Workbooks.Open("Template.xlsm") 'path missing? For Each ws In wbSource.Sheets wbDest.Sheets(ws.name).Range("C8:AB117").Value2 = ws.Range("C8:AB117").Value2 'change range? Next ws wbSource.Close SaveChanges:=False Application.ScreenUpdating = True End Sub