попробуйте этот фрагмент кода до и после вашего кода
ДО: 'sheet1 и sheet2 защищены
Dim pwd As String
Dim ws as WorkSheet
pwd = "password"
For Each ws In Worksheets
ws.Unprotect Password:=pwd
Next ws
' ваш код
ПОСЛЕ:
For Each ws In Worksheets
ws.protect Password:=pwd
Next ws
Надеюсь, это поможет
РЕДАКТИРОВАТЬ сообщение после вашего комментария
Option Explicit
Sub FilterAndCopy()
Dim pwd As String
Dim sht1, sht2 As Worksheet
Dim rng As Range
pwd = "password"
Set sht1 = Worksheets("SHIFT LOG")
Set sht2 = Worksheets("CHANGE OF NO'S")
sht2.Unprotect Password:=pwd 'unprotect the sheet
sht2.UsedRange.ClearContents ' clear contents
With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
.Cells.EntireColumn.Hidden = False
If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
.AutoFilter Field:=1, Criteria1:="Change of Numbers"
.Range("A:F, AD:AD, BL:BO").Copy Destination:=sht2.Cells(4, "B")
.Parent.AutoFilterMode = False
.Range("F:AD").EntireColumn.Hidden = True
.Range("AE:BK").EntireColumn.Hidden = True
End With
'Go to last cell in column B
With ActiveSheet
Range("B5").Select
Selection.End(xlDown).Select
End With
sht2.Protect Password:=pwd ' protect the sheet
End Sub