Question

如果用户单击工作表中的按钮，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

Answer 1

clickBreak不是事件处理程序。如果按钮名称为Break，则必须为sub命名 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

Answer 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

中得到了参考

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

2 个答案: