ActiveSheet.Paste Error on protected sheet

user_14036929 0
Viewed 222

I have 2 worksheets (Input & Record), I just want to copy some data from "Input" to "Record", it worked but if I protect "Record".... Paste method of Worksheet class Failed comes up. So I added script for unprotected sheets and protect sheets, but '1004' stil comes up. Here the detail of my project.

  • Input sheet is area for me to input some value to a row. In 1 row at least have 10 values at different column.
  • Maximum row that I can add is ten rows.
  • Record sheet is database as Table1 based on how much row from Input sheet that i'll add.

Here my script

Sub adddata() 'this sub code from button on "Input" sheet

Sheets("Input").Select
Range("C15").Offset(1, 0).Select 'select range start from C16
If Range("M27") = 1 Then 'value for how much row that i'll add
    Range(Selection, Selection.End(xlToRight)).Select
Else
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy

Sheets("Record").Select
Worksheets("Record").Unprotect Password:="4321"
If Range("B2").Offset(1, 0).Value = "" Then
    Range("B2").Offset(1, 0).Select
Else
    Range("B2").End(xlDown).Offset(1, 0).Select
End If
    ActiveSheet.Paste '<< The trouble maker
    Application.CutCopyMode = False
Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True

End Sub

That I want to know:

  1. What I've missed?
  2. The solution of this dilemma.
vba excel
2 Answers

I think all this Select process is not necessary and you can avoid that. I can edit my answer if you will add your intentions "what you are trying to do".

You want to copy some range from Input and paste it to Record always to the next empty row?

If I understood you correct, maybe something like this?

Sub adddata()

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("Record").Unprotect Password:="4321"
    
    Dim NextFreeCell As Range
    Set NextFreeCell = ThisWorkbook.Worksheets("Record").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1)
    
    With ThisWorkbook.Worksheets("Input")
        If .Range("B2").Value = 1 Then
            .Range("C15", .Range("C15").End(xlToRight)).Copy
        Else
            .Range("C15", .Range("C15").End(xlDown).End(xlToRight)).Copy
        End If
    End With
    
    NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True

    ThisWorkbook.Worksheets("Input").Activate
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    
    Exit Sub
    
ErrorHandler:

    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("Input").Activate
    Application.ScreenUpdating = True

    ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True

End Sub

Here is how it works:

enter image description here

This was not included in your original question. So you have to create a new question with additional information to your original question. However this time I will answer here but not next time.

Here is the code for table:

Sub adddata()

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("Record").Unprotect Password:="4321"
    
    With ThisWorkbook.Worksheets("Record").ListObjects("Table1").ListRows.Add
    
        With ThisWorkbook.Worksheets("Input")
            If .Range("B2").Value = 1 Then
                .Range("C15", .Range("C15").End(xlToRight)).Copy
            Else
                .Range("C15", .Range("C15").End(xlDown).End(xlToRight)).Copy
            End If
        End With
        
        .Range.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
    
    ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True

    ThisWorkbook.Worksheets("Input").Activate
    Application.ScreenUpdating = True
    Application.CutCopyMode = False

    Exit Sub

ErrorHandler:

    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("Input").Activate
    Application.ScreenUpdating = True

    ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True

End Sub

Remove all empty cells in table below your last data. This code will add a new line to table. Also table name should correspond to your table name. Can be found in Excel under Format Table

enter image description here

user_140238820

Try this.

Sub adddata()

Worksheets("Record").Unprotect Password:="4321" ' Unlock the target sheet before copying.

Sheets("Input").Select
Range("C15").Offset(1, 0).Select
If Range("M27") = 1 Then
    Range(Selection, Selection.End(xlToRight)).Select
Else
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy

Sheets("Record").Select
If Range("B2").Offset(1, 0).Value = "" Then
    Range("B2").Offset(1, 0).Select
Else
    Range("B2").End(xlDown).Offset(1, 0).Select
End If
    Activecell.PasteSpecial xlAll
    Application.CutCopyMode = False
Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True

End Sub
user_139449400
Related