Question

美好的一天我正在尝试运行一个非常简单的代码，我打开一个工作簿，复制列“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

尝试此操作，相应地激活Workbook对象，就像在真实的copypaste流程中一样。我在第三个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

编辑：好的，我迟到了，你在我的帖子之前发现了同样的修复。

Answer 2

正如您已经确定的那样，您的问题在于您是否正在使用activeworkbook进行复制，但忘记使用.Activate。比使用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

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

从一个工作簿复制到另一个工作簿的宏 - 不工作

2 个答案: