'ActiveSheet.Paste Error on protected sheet
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:
- What I've missed?
- The solution of this dilemma.
Solution 1:[1]
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:
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
Solution 2:[2]
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
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 | General Grievance |
Solution 2 |