Sub test1()
Dim arr1(), arr2(), arr3(), arr4(), arr5(), arr6(), arr7()
Dim rng1 As Range, rng2 As Range, i As Long, n As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sh1 = Worksheets("Лист1")
Set sh2 = Worksheets("Данные")
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(sh1.Cells(Rows.Count, 1).End(xlUp).Row, 7))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(sh2.Cells(Rows.Count, 1).End(xlUp).Row, 6))

lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr1 = rng1
arr2 = rng2

k = 0

ReDim arr3(UBound(arr1), 0), arr4(UBound(arr1), 0), arr5(UBound(arr1), 0), arr6(UBound(arr1), 0), arr7(UBound(arr1), 0)
For i = LBound(arr1) To UBound(arr1)
    For n = LBound(arr2) To UBound(arr2)
        If arr1(i, 7) = arr2(n, 1) Then
            arr3(i - 1, 0) = arr2(n, 2)
            arr4(i - 1, 0) = arr2(n, 3)
            arr5(i - 1, 0) = arr2(n, 4)
            arr6(i - 1, 0) = arr2(n, 5)
            arr7(i - 1, 0) = arr2(n, 6)
            
             Exit For
        End If
    Next n
Next i

sh1.Range("B2:B" & UBound(arr1) + 1) = arr3
sh1.Range("Z2:Z" & UBound(arr1) + 1) = arr4
sh1.Range("AB2:AB" & UBound(arr1) + 1) = arr5
sh1.Range("AC2:AC" & UBound(arr1) + 1) = arr6
sh1.Range("AD2:AD" & UBound(arr1) + 1) = arr7


Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Dim Sheet As Worksheet
 
    For Each Sheet In ActiveWorkbook.Worksheets
        If Sheet.Visible <> xlSheetVisible Then
            Sheet.Visible = xlSheetVisible
        End If
    Next
 
Sheets("Данные").Activate

Sub auto_open()

Sheets("Данные").Protect Password:="111", UserInterfaceOnly:=True, Contents:=True, Scenarios:=True

Dim Sheet As Worksheet

    For Each Sheet In ActiveWorkbook.Worksheets
        If Sheet.Visible <> xlSheetVisible Then
            Sheet.Visible = xlSheetVisible
        End If
    Next

Sheets("Данные").Activate
Rows("1:111").Hidden = True
    
x = InputBox("Введите пароль")

Select Case x

Case "129": Range("A1:A4").EntireRow.Hidden = False        
Case "148": Range("A1, A5:A7").EntireRow.Hidden = False    
Case "161": Range("A1, A8:A10").EntireRow.Hidden = False  
Case "183": Range("A1, A11:A13").EntireRow.Hidden = False  

...

End Select

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets("Данные").Select
    ActiveWindow.SelectedSheets.Visible = False
    
End Sub

Private Sub Workbook_Activate()

For i = 2 To 16: Rows(i).Visible = xlVeryHidden: Next i

x = InputBox("введите пароль")

Select Case x

Case "111": Rows("2:4").Visible = True
Case "222": Rows("5:7").Visible = True
Case "333": Rows("8:10").Visible = True
Case "444": Rows("11:13").Visible = True
Case "555": Rows("14:16").Visible = True

End Select
End Sub

Sub port()
Dim arr1(), arr2(), arr3(), arr4()
Dim rng1 As Range, rng2 As Range, i As Long, n As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh1 = Worksheets("1")
Set sh2 = Worksheets("2")
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(sh1.Cells(Rows.Count, 1).End(xlUp).Row, 2))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(sh2.Cells(Rows.Count, 1).End(xlUp).Row, 3))
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr1 = rng1
arr2 = rng2
k = 0
ReDim arr3(UBound(arr1), 0), arr4(UBound(arr1), 0)
For i = LBound(arr1) To UBound(arr1)
    For n = LBound(arr2) To UBound(arr2)
        If arr1(i, 1) = arr2(n, 1) And arr1(i, 2) = arr2(n, 2) Then
            arr3(i - 1, 0) = arr2(n, 3)
            arr4(i - 1, 0) = arr2(n, 4)
              
             Exit For
        End If
    Next n
Next i
sh1.Range("C2:C" & UBound(arr1) + 1) = arr3
sh1.Range("D2:D" & UBound(arr1) + 1) = arr4


Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub Перенос()
With Worksheets("1")
Ir = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
 If Range("A" & i).Value = Range("A" & i) And Range("B" & i).Value = Range("B" & i) Then
     .Range("C" & Ir).Value = Range("C" & i).Value
     Ir = Ir + 1
 End If
 Next
 End With
End Sub