將數據複製到其他工作簿時，VBA Excel未響應

我使用此簡單代碼將工作簿1中的工作表複製到同一文件夾中的工作簿2中。將數據複製到其他工作簿時，VBA Excel未響應

Sub Button27_Click() 
    Application.ScreenUpdating = False 
    Dim FileName As String 
    Workbooks.Open FileName:=ActiveWorkbook.Path & "\sefaresh.xlsm" 
    Application.Wait (Now + TimeValue("0:00:01")) 
    ThisWorkbook.Sheets("Sheet3").Copy 
    After:=Workbooks("sefaresh.xlsm").Sheets(Sheets.Count) 
    Application.ScreenUpdating = True 
End Sub

複製&粘貼功能過程順利，但如果我關閉工作簿2第一，我拿不響應爲Excel。任何建議？

感謝

來源

2016-04-03 reza bozorgifard

嘗試'DoEvents'

事情變得更加容易。 –

我以前使用過但不能正常工作 –

如果workbook2文件已損壞，請嘗試：將其重命名爲新名稱，將其所有內容（包括所有代碼）複製到新工作簿，將新wb保存爲工作簿2的舊名稱，然後再次嘗試你的宏。 –

試試這個（未經檢驗）。你現在不應該得到一個錯誤。如果你使用對象:)你分結束

Sub Button27_Click() 
    Dim wbThis As Workbook, wbThat As Workbook 
    Dim ws As Worksheet 
    Dim fName As String 

    On Error GoTo Whoa 

    Set wbThis = ThisWorkbook 
    Set ws = wbThis.Sheets("Sheet3") 

    fName = wbThis.Path & "\sefaresh.xlsm" 

    Application.ScreenUpdating = False 

    Set wbThat = Workbooks.Open(fName) 

    DoEvents 

    ws.Copy After:=wbThat.Sheets(wbThat.Sheets.Count) 

    '~~> close and save the workbook 
    wbThat.Close (True) 

    DoEvents '<~~ Give time for it to save and close 

LetsContinue: 
    Application.ScreenUpdating = True 
    MsgBox "Done" 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub

來源

2016-04-03 09:25:30

我這樣做，但同樣的問題。我收到了DONE消息，但在此之後，當我打開工作簿2時我沒有迴應。 –

看起來像你的工作簿2已損壞。您可以通過將數據從該文件複製到新文件來創建該文件的新副本。不要通過直接複製粘貼文件來創建副本。 –

一個新的工作簿2，但不能再次工作。 –

將數據複製到其他工作簿時，VBA Excel未響應

回答

相關問題