Excel VBA Code doesn't insert and Paste Values to a protected sheet

Question

Sub ShopeEntry()

    Sheets("Entry").Select
    Range("D5").Select
    
    If IsEmpty(Selection.Value) = False Then
    
        Sheets("Entry").Select
        Dim last_row As Long
        last_row = Cells(Rows.Count, 4).End(xlUp).Row
        Range(Cells(5, 3), Cells(last_row, 10)).Select
        Selection.Copy
    
        Sheets("List").Select
        Selection.Protect Password:="Password", UserInterfaceOnly:=True
    
        Sheets("List").Select
        Range("C2").Select
        Selection.Insert Shift:=xlDown
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("Entry").Select
        Range("D5").Select
    
    End If
    
End Sub

When I run this Code in Excel VBA, an Error message shows up at the Paste Special Command.

Basically, the code is supposed to copy the entries from Sheet "Entry" Then Insert & Paste only Values in Sheet "List"

Sheet List has a protection password that must be preventing other users from editing but still let VBA code paste the values.

Error Message is "Run-time error '1004': Select Method of Range Class Failed"

Kindly, let me know if you managed to get what needs to be done to get it running smoothly!

Thank you in advance!

What error do you get? In which line you get an error? You may also have a look onto How to avoid select — Shrotter
– Shrotter, Commented 2 days ago
@Shrotter I can't thank you enough for the post you referred to for select and how to avoid it. the Error message is "Run-time error '1004': Select Method of Range Class Failed" — David
– David, Commented 2 days ago
Set this in the workbook_open event. Sheets("List").Protect Password:="Password", UserInterfaceOnly:=True — Siddharth Rout
– Siddharth Rout, Commented 2 days ago

CDP1802 · Accepted Answer · 2025-11-20 14:46:39Z

1

Use Unprotect then Protect

Option Explicit

Sub ShopeEntry()

   Const PASSWD = "Password"

    Dim wsEntry As Worksheet, wsList As Worksheet
    Dim ar, lastrow As Long, r As Long, c As Long
    
    With ThisWorkbook
        Set wsEntry = .Sheets("Entry")
        Set wsList = .Sheets("List")
    End With

    With wsEntry
        If Not IsEmpty(.Range("D5")) Then
            ' copy values to array
            lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
            ar = .Range("C5:J" & lastrow)
            r = UBound(ar) ' no of rows
            c = UBound(ar, 2) ' no of columns
        End If
    End With
    
    If r > 0 Then
        With wsList
           .Unprotect PASSWD
            ' copy array to sheet
           .Rows(2).Resize(r).Insert Shift:=xlDown
           .Range("C2").Resize(r, c) = ar
           .Protect PASSWD, UserInterfaceOnly:=True
        
            MsgBox r & " rows inserted in " & .Name, vbInformation
        End With
    End If
    
End Sub

edited yesterday

answered yesterday

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

David yesterday

This answer worked great! Is it possible to have last_row starting to look for the non empty cell starting from a certain fixed cell? How might that be?

CDP1802 yesterday

@David Use lastrow = .Range("D5").End(xlDown).Row

CDP1802 23 hours ago

@David Note Range("D5").End(xlDown) will give last row of sheet if D6 is empty.

motosann · Accepted Answer · 2025-11-20 22:41:47Z

0

Microsoft® Excel® for Microsoft 365 MSO (バージョン 2510 ビルド 16.0.19328.20190) 64 ビット

I have preserved the logic of the question as much as possible.

I have changed it to copy just before pasting.

The scope of With has been changed.

Sub ShopeEntry()

    Dim wsEntry As Worksheet
    Dim wsList As Worksheet
    Dim rngSource As Range
    Dim last_row As Long
    
    Set wsEntry = Sheets("Entry")
    Set wsList = Sheets("List")
    
    If IsEmpty(wsEntry.Range("D5").Value) = False Then
    
        With wsEntry
            last_row = .Cells(.Rows.Count, 4).End(xlUp).Row
            Set rngSource = .Range(.Cells(5, 3), .Cells(last_row, 10))
        End With
        
        With wsList
            .Protect Password:="Password", UserInterfaceOnly:=True
            .Range("C2").Insert Shift:=xlDown
            rngSource.Copy
            .Range("C2").PasteSpecial Paste:=xlPasteValues
        End With
        Application.CutCopyMode = False
        With wsEntry
            .Select
            .Range("D5").Select
        End With
        
    Else

    End If
    
End Sub

edited yesterday

answered yesterday

motosann

244 bronze badges

4 Comments

David yesterday

Is it possible to have last_row starting to look for the non empty cell starting from a certain fixed cell? How might that be?

motosann 17 hours ago

I am not sure what I want to do.The bottom right cell of the smallest area (CurrentRegion) surrounded by empty rows and columns can be determined as follows. Dim rngLastCell As Range With wsEntry.Range("D5").CurrentRegion Set rngLastCell = .Cells(.Count) End With

motosann 13 hours ago

If you loop through a worksheet to search, you can use the Worksheet.UsedRange property to limit the range you loop through.

motosann 11 hours ago

The used bottom-right cell can also be retrieved as shown below. Set rngLastCell = wsSheet1.Cells.SpecialCells(xlCellTypeLastCell)

VBasic2008 · Accepted Answer · 2025-11-20 16:08:46Z

Insert Data

Sub ArchiveEntries()
    
    ' Define constants.
    Const PW As String = "123"
    Const OK_TO_CLEAR_INSERTED_FORMATS As Boolean = True
    Const OK_TO_SELECT_TOP_SOURCE_CELL As Boolean = False
    Const OK_TO_DISPLAY_NO_DATA_MESSAGE As Boolean = True
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it's not, reference it by its name or use 'ActiveWorkbook'.
    
    ' Build the source range.
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Entry")
    Dim stcell As Range: Set stcell = sws.Range("D5")
    
    Dim RowsCount As Long: RowsCount = _
        sws.Cells(sws.Rows.Count, stcell.Column).End(xlUp).Row - stcell.Row + 1
    If RowsCount < 1 Then
        If OK_TO_DISPLAY_NO_DATA_MESSAGE Then
            MsgBox "No data found in ""'" & sws.Name & "'!" _
                & stcell.Resize(sws.Rows.Count - stcell.Row + 1).Address(0, 0) _
                & """!", vbExclamation
        End If
        Exit Sub
    End If
    
    Dim srg As Range: Set srg = _
        stcell.EntireRow.Columns("C:J").Resize(RowsCount)
        
    ' Build the destination range.
        
    Dim dws As Worksheet: Set dws = wb.Sheets("List")
    Dim dfcell As Range: Set dfcell = dws.Range("C2")
    Dim drg As Range: Set drg = dfcell.Resize(srg.Rows.Count, srg.Columns.Count)
    
    ' Unprotect, insert and protect again.
    
    dws.Unprotect Password:=PW
    
    drg.Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
    Set drg = drg.Offset(-RowsCount) ' was shifted down
    If OK_TO_CLEAR_INSERTED_FORMATS Then drg.ClearFormats
    drg.Value = srg.Value
    
    dws.Protect Password:=PW, UserInterfaceOnly:=True
    
    ' Select the top ('last-row-calculating') source cell (hardly necessary).
    If OK_TO_SELECT_TOP_SOURCE_CELL Then Application.Goto stcell
    
    ' Display a message to let the user know the code has run successfully.
    MsgBox "Entries archived.", vbInformation
    
End Sub

Collectives™ on Stack Overflow

Excel VBA Code doesn't insert and Paste Values to a protected sheet

3 Answers 3

3 Comments

4 Comments

Insert Data

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

3 Comments

4 Comments

Insert Data

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related