Home > database >  PasteSpecial method of Range class failed on first run but not on second
PasteSpecial method of Range class failed on first run but not on second

Time:11-16

my original plan was to copy from a merged & centered range of A1:AG5 into the same size in the second book to no available with various cut and paste options.

After doing more reading and following others I have almost got it after tryingdifferent copy and paste options. Copy from a specified Workbook range (A1:A5), these are text values. Paste into active workbook which could be of any name to the range of (A35:A39).

Error pop up

Run-time error 1004, PasteSpecial Method of Range class failed.

Cells A1, A2, A3, A4 and A5 each has a text sentence which copies and pastes to A35, A36, A37,A38 and A39.

I can run the script and the error box pops up, click END and run the macro button again and the end result meets my requiremnts with the 5 rows having text copied from another book from A to AG with text centered across horizontally,

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

CodePudding user response:

You might benefit from reading How to avoid using Select in Excel VBA.

Always copy right before you paste. Otherwise the code in between can interfere. Use Variables instead of selecting and activating sheets or ranges. Use With blocks and/or variables to avoid repeating code and worksheet names.

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

The issue why your code worked the second time you run it is, that it stoped somewhere after .Unprotect and you sheet was left unprotected. So the second run was on an unprotecdet sheet then.

Usually you want to cover that using error handling. So your sheet does never end in an unprotected state.

This is a basic error handling to ensure the sheet is protected again in the case of an error

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
  • Related