将数据从一个工作簿复制到另一个工作簿时 Excel 挂起答案

【问题标题】：Excel hang while copying data from one workbook to another将数据从一个工作簿复制到另一个工作簿时 Excel 挂起
【发布时间】：2014-05-02 08:56:44
【问题描述】：

如果用户单击工作表中的按钮，Excel 会挂起。该按钮允许用户运行以下 VBA 代码。如果用户从 VBA 编辑器运行代码，它工作正常。请帮忙。代码如下。我正在尝试将数据从当前的 excel 文件复制到新创建的另一个 excel 文件中。

Sub clickBreak()
i = 12
Dim workBookName As String
Dim workBookName2 As String
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim pasteStart As Range

workBookName = Application.ActiveWorkbook.FullName

workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
MsgBox workBookName2

Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")

xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wb1 = Workbooks.Open(Filename:=workBookName)

Set pasteStart = [A12:A15]
wb1.Sheets("contents").Range("A12:A15").Copy
Set wb2 = Workbooks.Open(Filename:=workBookName2)
wb2.Sheets("contents").Range("A12:A:15").PasteSpecial xlPasteAll
wb2.Save

End Sub

【问题讨论】：

标签： vba excel

【解决方案1】：

clickBreak 不是事件处理程序。如果您的按钮名称是 Break 您必须命名子 BreaK_Click() 作为按钮单击事件的事件处理程序：

Sub BreaK_Click()
...
End Sub

完整代码：

Sub BreaK_Click()
i = 12
Dim workBookName As String
Dim workBookName2 As String
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim pasteStart As Range

workBookName = Application.ActiveWorkbook.FullName

workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
MsgBox workBookName2

Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")

xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wb1 = Workbooks.Open(Filename:=workBookName)

Set pasteStart = [A12:A15]
wb1.Sheets("contents").Range("A12:A15").Copy
Set wb2 = Workbooks.Open(Filename:=workBookName2)
wb2.Sheets("contents").Range("A12:A:15").PasteSpecial xlPasteAll
wb2.Save

End Sub

【讨论】：

【解决方案2】：

我得到了答案

Sub clickBreak()
 Dim workBookName As String
   Dim workBookName2 As String
   Dim wbTarget            As Workbook
   Dim wbThis              As Workbook
   Dim strName             As String

   Set wbThis = ActiveWorkbook


   strName = ActiveSheet.Name

    workBookName = Application.ActiveWorkbook.FullName

    workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"

    Dim xlobj As Object
    Set xlobj = CreateObject("Scripting.FileSystemObject")

    xlobj.CopyFile workBookName, workBookName2, True
    Set xlobj = Nothing



   Set wbTarget = Workbooks.Open(workBookName2)


   wbTarget.Sheets("contents").Range("A1").Select


   wbTarget.Sheets("contents").Range("A12:A15").ClearContents


   wbThis.Activate


   Application.CutCopyMode = False


   wbThis.Sheets("contents").Range("A12:A15").Copy


   wbTarget.Sheets("contents").Range("A12:A15").PasteSpecial


   Application.CutCopyMode = False


   wbTarget.Save


   wbTarget.Close


   wbThis.Activate

   'clear memory
   Set wbTarget = Nothing
   Set wbThis = Nothing


End Sub

感谢您花时间回答我的问题并提供反馈。很抱歉回答我自己的问题，我只是想与遇到同样问题的其他人分享我的解决方案。我从这个http://en.kioskea.net/faq/24666-excel-vba-copy-data-to-another-workbook得到了参考

【讨论】：