macros从一个工作簿复制到另一个 – 不工作

美好的一天，我试图运行一个非常简单的代码，我打开一个工作簿，复制列“a：a”，打开另一个工作簿，并粘贴在那里。 我面临的问题是数据正在从第二个工作簿复制到第二个工作簿，没有任何东西正在从第一个被复制。 下面的代码更清晰

Sub Copytocurrent() strSecondFile = "Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\RECEIVABLE.xls" strThirdFile = "Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\Working File - UAE.xlsx" Set wbk2 = Workbooks.Open(strSecondFile) Set wbk3 = Workbooks.Open(strThirdFile) '-------------------------------------------------------' 'Copy column A in Receivable to Column XB in Working File' '-------------------------------------------------------' Application.CutCopyMode = False wbk2.Sheets("receivable").Activate With wbk2.Sheets("receivable") Range("a:a").Copy End With wbk3.Sheets("Sheet1").Activate With wbk3.Sheets("sheet1") Range("XB1").PasteSpecial End With '-------------------------------------------------------' 'Copy column B in Receivable to Column XA in Working File' '-------------------------------------------------------' Application.CutCopyMode = False wbk2.Sheets("receivable").Activate With wbk2.Sheets("receivable") Range("b:b").Copy End With wbk3.Sheets("Sheet1").Activate With wbk3.Sheets("sheet1") Range("XA1").PasteSpecial End With wbk2.Close True wbk3.Close True End Sub 

Answer 1

正如你已经确定，你的问题是，你正在使用activeworkbook进行复制，但忘记使用。激活。 比使用ActiveWorkbook更好，请尝试直接访问范围。 这使得代码更加健壮 – 并且不那么臃肿：

 Sub CopyToCurrent() Dim wbkSource As Workbook, wbkTarget As Workbook 'Alays Dim your variables to prevent errors from typos! Dim wsSource As Worksheet, wsTarget As Worksheet Application.ScreenUpdating = False 'Prevent screen flickering Set wbkSource = Workbooks.Open("Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\RECEIVABLE.xls") Set wbkTarget = Workbooks.Open("Z:\AR\AR PROGRESS\2014\MENACA REPORTS\0MENACA Working File\AR Working File\UAE\Working File - UAE.xlsx") Set wsSource = wbkSource.Sheets("receivable") Set wsTarget = wbkTarget.Sheets("Sheet1") wsSource.Range("A:A").Copy wsTarget.Range("XB1").PasteSpecial wsSource.Range("B:B").Copy wsTarget.Range("XA1").PasteSpecial wbkSource.Close False 'No need to save any changes wbkTarget.Close True Application.ScreenUpdating = True End Sub 

请注意，我还添加了一些小的改进（调暗，防止屏幕闪烁）

Answer 2

试试这个，像在真正的copypastestream程中一样，激活Workbook对象。 我在第三个xlsm工作簿中运行这个方法。

 Public Sub testCopy() Dim wb1 As Workbook Dim wb2 As Workbook Set wb1 = Workbooks.Open("C:\projects\excel\book1.xlsx") Set wb2 = Workbooks.Open("C:\projects\excel\book2.xlsx") Application.CutCopyMode = False wb1.Activate With wb1.Sheets("Sheet1") Range("A:A").Copy End With wb2.Activate With wb2.Sheets("Sheet1") Range("E1").PasteSpecial End With Application.CutCopyMode = False wb1.Activate With wb1.Sheets("Sheet1") Range("B:B").Copy End With wb2.Activate With wb2.Sheets("Sheet1") Range("F1").PasteSpecial End With wb1.Close True wb2.Close True End Sub 

编辑：好吧我迟到了，你在我的post前发现了同样的问题。