在工作簿之间复制数据时，对象不支持此属性或方法

我对VBA相当陌生，在以下问题上需要您的帮助。 提前致谢。

我有两本外汇价格的工作手册。 一个工作簿包含投标价格，另一个包含Ask价格，我想将Ask price工作簿中的数据复制到投标价格工作簿。 因为我有很多这样的Bid and Ask工作簿，所以我需要VBA来自动化这个过程。 我到目前为止所做的代码是：

1. 打开出价工作簿
2. 得到出价工作簿的path和文件名，并据此得到Ask price工作簿的文件名和path
3. 使用获得的文件名和path来打开要价工作簿（我现有的代码工作正常到这一点）
4. 将Ask价格工作簿中的所有数据复制到Bid price Workbook第4步是我填充的地方，并得到“对象不支持此特性或方法错误”。

我希望你们能帮助解决这个问题。 非常感谢。 以下是我的代码。 这两个工作簿的链接在这里：

https://drive.google.com/folderview?id=0B2YYk8FCgGVkeVBMYmFMUGt6amc&usp=sharing

Sub getAskPrice() Dim currentWb As Workbook Dim openWb As Workbook Dim currentWs As String Dim openWs As String Dim path As String Dim targetPath As String Set currentWb = ActiveWorkbook currentWs = ActiveSheet.Name Range("K1") = currentWs path = ThisWorkbook.FullName targetPath = WorksheetFunction.Substitute(path, "Bid", "Ask") Range("K2") = targetPath Set openWb = Workbooks.Open(targetPath) openWs = ActiveSheet.Name openWb.Sheets(openWs).Activate Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy currentWb.Activate Range("H1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 

问候，我的

Answer 1

用currentWb.ActiveSheet.PasteSpecialreplaceSelection.PasteSpecial 。 Excel可以非常挑剔你如何复制/粘贴单元格。 如果您决定从范围复制到范围，则需要您具有完全相同的范围大小。 而粘贴到表单将使您只有一个单元格被选中。

---

在你的代码中有几个通配符，这意味着你不能总是知道如果你的程序总是以相同的方式运行。 通常不build议使用Activesheet因为每次工作簿最后一次使用不同的工作表保存时，它都会有所不同。 而且，每次使用Sheets对象而不是每次引用其名称都更安全。

这是你的代码的修正版本（现在完美）:)

 Sub getAskPrice() Dim currentWb As Workbook, openWb As Workbook Dim currentWs As Worksheet, openWs As Worksheet Dim myPath As String, targetPath As String Set currentWb = ThisWorkbook Set currentWs = currentWb.Sheets(1) 'change this "1" to the index number of the sheet you wanna work with myPath = ThisWorkbook.FullName targetPath = WorksheetFunction.Substitute(myPath, "Bid", "Ask") Set openWb = Workbooks.Open(targetPath) Set openWs = openWb.Sheets(1) 'change this "1" to the index number of the sheet you wanna work with lastCol = openWs.Cells(1, openWs.Columns.Count).End(xlToLeft).Column lastRow = openWs.Cells(openWs.Rows.Count, 1).End(xlUp).Row openWs.Range(openWs.Cells(1, 1), openWs.Cells(lastRow, lastCol)).Copy currentWs.Range("H1").PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks :=False, Transpose:=False End Sub 

请注意，我删除了一些无用的行。