Ошибка ActiveSheet.Paste на защищенном листе [решено]

Question

У меня есть 2 рабочих листа (Ввод и Запись), я просто хочу скопировать некоторые данные из «Входа» в «Запись», это сработало, но если я защищу «Запись» .... Вставить метод класса Worksheet Появляется ошибка . Поэтому я добавил скрипт для незащищенных листов и защиты листов, но все равно появляется «1004». Вот подробности моего проекта.

• Input sheet - это область, в которой я могу ввести какое-либо значение в строку. В 1 строке должно быть не менее 10 значений в разных столбцах.
• Максимальное количество строк, которые я могу добавить, - десять строк.
• Запись лист - это база данных как Таблица1 в зависимости от того, сколько строк из Введите лист, который я добавлю.

Здесь мой сценарий

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

Что я хочу знать:

1. Что я пропустил?
2. Решение этой дилеммы.

Спасибо за @Tabisamsa и @Karan, оба ваших кода успешны и Я получил новый опыт.

Answer 1

Этот сайт немного не очень дружелюбен для новичков. Я не могу комментировать, так как у меня недостаточно репутации. Не могли бы вы добавить к своему вопросу, что вы пытаетесь сделать? Я думаю, что весь этот процесс Select не нужен, и вы можете этого избежать. Я могу отредактировать свой ответ, если вы добавите свои намерения «что вы пытаетесь сделать».

Вы хотите скопировать некоторый диапазон из Input и вставить его в Record всегда в следующую пустую строку?

Если я вас правильно понял, может что-то вроде этого?

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

Вот как это работает:

---

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

введите описание изображения здесь

Answer 2

Попробуйте это.

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