Range類的PasteSpecial方法在第一次運行時失敗但在第二次運行時失敗

我最初的計劃是從 A1:AG5 的合并和居中范圍復制到第二本書中的相同大小，以使用各種剪切和粘貼選項不可用。

在做了更多閱讀和關注其他人之后，我在嘗試不同的復制和粘貼選項后幾乎得到了它。從指定的作業簿范圍 (A1:A5) 復制，這些是文本值。粘貼到活動作業簿中，該作業簿可以是 (A35:A39) 范圍內的任何名稱。

彈出錯誤

運行時錯誤 1004，Range 類的 PasteSpecial 方法失敗。

單元格 A1、A2、A3、A4 和 A5 各有一個文本句子，可復制并粘貼到 A35、A36、A37、A38 和 A39。

我可以運行腳本并彈出錯誤框，單擊“結束”并再次運行宏按鈕，最終結果滿足我的要求，其中 5 行的文本從另一本書從 A 復制到 AG，文本水平居中，

Option Explicit
Private Sub UpdateForm1_Click()

    'Dim wsActive As Worksheet
    'Set wsActive = ThisWorkbook.ActiveSheet
    Dim wbActive As Workbook
    Set wbActive = ThisWorkbook
    
    Dim Up_Location As String
    Dim Up_Name As String
    Up_Location = "T:\Repeats\"
    Up_Name = "PNL_UPDATE.xlsx"
    
    
 Application.ScreenUpdating = False
    Workbooks.Open Up_Location & Up_Name
        Worksheets("Sheet1").Activate
            ActiveSheet.Range("Text_1").Select
                ActiveSheet.Range("Text_1").Copy

    
    wbActive.Sheets("CustQuote").Unprotect Password:="1234"
    
    wbActive.Worksheets("CustQuote").Activate
    wbActive.Worksheets("CustQuote").Range("A35:A39").Select
    wbActive.Worksheets("CustQuote").Range("A35:A39").PasteSpecial xlPasteAll


    Range("A35:AG39").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
    End With
    Range("E2").Select
    wbActive.Sheets("CustQuote").Protect Password:="1234"
    
    Application.CutCopyMode = False
    Windows("PNL_UPDATE.xlsx").Activate
    ActiveWorkbook.Close
 Application.ScreenUpdating = True

End Sub

uj5u.com熱心網友回復：

您可能會受益于閱讀 如何避免在 Excel VBA 中使用 Select。

總是在粘貼之前先復制。否則中間的代碼可能會干擾。使用變數而不是選擇和激活作業表或范圍。使用With塊和/或變數來避免重復代碼和作業表名稱。

Option Explicit

Private Sub UpdateForm1_Click()
    Const ThisWbPassword As String = "1234" ' define password only once as constant.
    
    Dim Up_Location As String
    Up_Location = "T:\Repeats\"
    
    Dim Up_Name As String
    Up_Name = "PNL_UPDATE.xlsx"
    
    Dim WbUp As Workbook  ' set opened workbook to a variable for easy later use
    Set WbUp = Workbooks.Open(Up_Location & Up_Name)

    With ThisWorkbook.Worksheets("CustQuote")
        .Unprotect Password:=ThisWbPassword
        WbUp.Worksheets("Sheet1").Range("Text_1").Copy  ' always copy right before pasting to avoid interference of code between.
        
        With .Range("A35:A39")
            .PasteSpecial xlPasteAll
            .HorizontalAlignment = xlCenterAcrossSelection
            .VerticalAlignment = xlCenter
            .ReadingOrder = xlContext
        End With

       .Protect Password:=ThisWbPassword
    End With
    
    Application.CutCopyMode = False
    WbUp.Close SaveChanges:=False
End Sub

為什么你的代碼在你第二次運行它時起作用的問題是，它在某處停止.Unprotect并且你的作業表沒有受到保護。所以第二次運行是在一張未受保護的紙上。

通常你想使用錯誤處理來解決這個問題。因此，您的作業表永遠不會以未受保護的狀態結束。

這是一個基本的錯誤處理，以確保在發生錯誤時再次保護作業表

Private Sub UpdateForm1_Click()
    Const ThisWbPassword As String = "1234" ' define password only once as constant.
    
    Dim Up_Location As String
    Up_Location = "T:\Repeats\"
    
    Dim Up_Name As String
    Up_Name = "PNL_UPDATE.xlsx"
    
    Dim WbUp As Workbook  ' set opened workbook to a variable for easy later use
    Set WbUp = Workbooks.Open(Up_Location & Up_Name)

    With ThisWorkbook.Worksheets("CustQuote")
        .Unprotect Password:=ThisWbPassword
        On Error GoTo ReProtect ' in case of any error make sure the sheet is protected again
        WbUp.Worksheets("Sheet1").Range("Text_1").Copy  ' always copy right before pasting to avoid interference of code between.
        
        With .Range("A35:A39")
            .PasteSpecial xlPasteAll
            .HorizontalAlignment = xlCenterAcrossSelection
            .VerticalAlignment = xlCenter
            .ReadingOrder = xlContext
        End With
        
ReProtect:
       .Protect Password:=ThisWbPassword
       Err.Raise Err.Number 'throw the error message after protecting the sheet
    End With
    
    Application.CutCopyMode = False
    WbUp.Close SaveChanges:=False
End Sub

標籤：擅长VBA复制粘贴

上一篇：復制特定行資料

下一篇：函式檢查作業表是否存在