簡體   English   中英

將數據從一個工作簿復制到另一個工作簿時,Excel掛起

[英]Excel hang while copying data from one workbook to another

如果用戶單擊工作表中的按鈕,則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

clickBreak不是事件處理程序。 如果按鈕的名稱為Break,則必須將其命名為BreaK_Click()以使其充當按鈕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

我得到了答案

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獲得了參考

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM