CODEWITHSUNDEEP
excelvba
user3100310
user3100310

Reputation: 11

PasteSpecial method of Range class failed when I added password protection

The following macro works fine without the 1st and 3rd lines emphasised (i.e. password protection). When I add the code the macro works the first time but if I open the file again, it returns a run time error 'pastespecial method of range class failed' at the line second line emphasised. The purpose of the macro is to open a purchase order template, increment the purchase order number by one, complete a second log file with date, purchase order number and user name and re-save the purchase order template under a different file name:

Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "Please use dropdown arrow next to filename within SharePoint and select 'Edit in Microsoft Office Excel' instead."
ThisWorkbook.Close
End If
Range("L14") = Range("L14") + 1
ActiveWorkbook.Save
Range("L14").Copy
Workbooks.Open Filename:="\\ehfnp01\users\gminter\My Documents\PO Log Elite\PO  Log   Elite.xls"
Workbooks("PO Log Elite.xls").Activate
Dim lst As Long
With ActiveWorkbook.Sheets("Sheet1")
*.Unprotect Password:="2"*
lst = .Range("B" & Rows.Count).End(xlUp).Row + 1
**.Range("B" & lst).PasteSpecial xlPasteValuesAndNumberFormats**
End With
With ActiveWorkbook.Sheets("Sheet1")
lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & lst) = Now
End With
With ActiveWorkbook.Sheets("Sheet1")
lst = .Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("C" & lst).Value = Environ("Username")
*.Protect Password:="2"*
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
ThisFile = Application.DefaultFilePath & "\" & Range("G14").Value & Range("L14").Text
ActiveWorkbook.SaveAs Filename:=ThisFile
Range("L15") = Now
Range("E20").Value = Environ("Username")
ScreenUpdating = False
Set Rng = Intersect(ActiveSheet.UsedRange, Range("e20"))
For Each C In Rng
C.Value = StrConv(C.Value, vbUpperCase)
Next
ScreenUpdating = True

Cells.Locked = False
Range("G14:N15,E20:N20").Locked = True
ActiveSheet.Protect Password:="1"

Dim x               As Integer

On Error Resume Next
With ActiveWorkbook.VBProject
    For x = .VBComponents.Count To 1 Step -1
        .VBComponents.Remove .VBComponents(x)
    Next x
    For x = .VBComponents.Count To 1 Step -1
        .VBComponents(x).CodeModule.DeleteLines _
        1, .VBComponents(x).CodeModule.CountOfLines
    Next x
End With
On Error GoTo 0

End Sub

Any help would be greatly appreciated as I can't find any similar examples of this.

Upvotes: 1

Views: 925

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149305

What happens when you explicitly declare your Objects/Variables and then work with them? That ways you do the copy just before you paste. This will ensure that the clipboard doesn't get cleared for any reason which Excel is unfortunately famous for...

Private Sub Workbook_Open()
    Dim rng As Range
    Dim newWb As Workbook, wb As Workbook
    Dim lst As Long

    If ThisWorkbook.ReadOnly Then
        MsgBox "Please use dropdown arrow next to filename within SharePoint and select 'Edit in Microsoft Office Excel' instead."
        ThisWorkbook.Close
        Exit Sub '<~~ ?
    End If

    Set rng = ThisWorkbook.Sheets("Sheet1").Range("L14")
    rng.Value = rng.Value + 1

    ThisWorkbook.Save

    Set newWb = Workbooks.Open(Filename:="\\ehfnp01\users\gminter\My Documents\PO Log Elite\PO  Log   Elite.xls")

    Set wb = Workbooks("PO Log Elite.xls")

    With wb.Sheets("Sheet1")
        .Unprotect Password:="2"
        lst = .Range("B" & .Rows.Count).End(xlUp).Row + 1

        rng.Copy '<~~ Do the copy here
        .Range("B" & lst).PasteSpecial xlPasteValuesAndNumberFormats
    End With

    '
    '~~> Rest of the code
    '
End Sub

Upvotes: 1

Related Questions