Sub Снять_фильтр()
On Error GoTo m
ActiveSheet.ShowAllData
Exit Sub
m:
MsgBox "Фильтра не установлены"
End Sub

Sub ProtectionProcedure()
    With ThisWorkbook
        .Worksheets("1111").Protect Password:="1111", UserInterfaceOnly:=True
    End With
End Sub

Option Explicit
Const HEADER_COLUMN = 4 ' Шапка таблици в которую вставляем данныеFunction getLastRowCell(sh As Worksheet, Optional colNum& = 1)
    getLastRowCell = sh.Cells(sh.Rows.Count, colNum).End(xlUp).Row + 1
End FunctionSub П1()
    Dim rng As Range
    Dim r&
    Dim rr As Range
    Dim arrFrom, arrTo
    Dim shFrom As Worksheet
    Dim shTo As Worksheet
    Dim col&
    Dim lngLastRow&
    
    Set shFrom = Worksheets("Заявки")
    Set shTo = Worksheets("Поставки_ПП")
    
    Set rng = shFrom.[a2].CurrentRegion
    Set rng = rng.Resize(rng.Rows.Count + 2)
    
    arrTo = Split("a", " ")
    arrFrom = Split("y", " ")
    
    lngLastRow = getLastRowCell(shTo)
    If lngLastRow > HEADER_COLUMN Then
        Range(shTo.Cells(HEADER_COLUMN + 1, 1), _
              shTo.Cells(lngLastRow, 1)).EntireRow.Delete
        lngLastRow = getLastRowCell(shTo)
    End If
    lngLastRow = WorksheetFunction.Min(HEADER_COLUMN + 1, lngLastRow)
    
    For r = 1 To rng.Rows.Count
        Set rr = rng.Rows(r)
'        rr.Parent.Activate
 '       rr.Select
        
        If Not rr.Hidden And rr.Row > 2 Then
            For col = LBound(arrTo) To UBound(arrTo)
'                shTo.Activate
  '              shTo.Cells(lngLastRow, arrTo(col)).Select
    '            shFrom.Activate
      '          shFrom.Cells(2, arrFrom(col)).Select
                shTo.Cells(lngLastRow, arrTo(col)) = rr.Cells(, arrFrom(col))
                DoEvents
            Next
            lngLastRow = lngLastRow + 1
        End If
    Next
  
End Sub

Private Sub CommandButton14_Click()
Worksheets(22).Visible = -1
Worksheets(1).Visible = 2
Worksheets(2).Visible = 2
Worksheets(3).Visible = 2
Worksheets(4).Visible = 2
Worksheets(5).Visible = 2
Worksheets(6).Visible = 2
Worksheets(7).Visible = 2
Worksheets(8).Visible = 2
Worksheets(9).Visible = 2
Worksheets(10).Visible = 2
Worksheets(11).Visible = 2
Worksheets(12).Visible = 2
Worksheets(13).Visible = 2
Worksheets(14).Visible = 2
Worksheets(15).Visible = 2
Worksheets(16).Visible = 2
Worksheets(17).Visible = 2
Worksheets(18).Visible = 2
Worksheets(19).Visible = 2
Worksheets(20).Visible = 2
Worksheets(21).Visible = 2
UserForm1.Hide

End Sub

Sub Отчеты_для_заполнения()
Shell "explorer.exe " & ThisWorkbook.Path & "D:\E", vbMaximizedFocus
End Sub

Sub Filter_()
    Dim iFilter_ As String
    iFilter_ = Range("K1")
    ActiveSheet.ListObjects("Таблица14").Range.AutoFilter Field:=20, Criteria1:= _
        iFilter_
    If Range("K1").Value = "Все" Then
    ActiveSheet.ListObjects("Таблица14").Range.AutoFilter Field:=20 ' 20 номер столбца 
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range: Set rng = [K1]
    If Not Intersect(rng, Target) Is Nothing Then Filter_
End Sub