Sub HiddenRow1()
Dim oSD As Object, arr(), x As Long
Dim oSht1 As Worksheet, oRng As Range, vl As Object
'Dim iTimer
'iTimer = Timer
Set oSD = CreateObject("Scripting.Dictionary"): oSD.comparemode = 1
  With ActiveWorkbook 
    For Each vl In .Worksheets
      If vl.Name Like "380*" Then Set oSht1 = .Sheets(vl.Name)
    Next
    If oSht1 Is Nothing Then MsgBox "Листа 380* нет в файле, досрочное завершение работы", vbCritical: Exit Sub

    With .Sheets("Лист1") ''' c этого листа отбираем данные для дальнейшего анализа
      .Activate: .Cells(1, 1).Select   '''переключаемся на Лист1 для ускорения выполнения процедуры
      arr = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    For x = LBound(arr) To UBound(arr):  If Not oSD.exists(arr(x, 1)) Then oSD.Add arr(x, 1), 0
    Next x
    Erase arr
    
Application.ScreenUpdating = False
    ''' работаем с листом 380* анализ данных и дальнейшее скрытие строк
    Set oRng = oSht1.Range(oSht1.Cells(1, 6), oSht1.Cells(Rows.Count, 6).End(xlUp))
      For Each vl In oRng 'цикл по колонке F листа 380*
        If Not IsEmpty(vl.Value) Then: If oSD.exists(vl.Value) Then vl.EntireRow.Hidden = True
      Next
  End With
oSht1.Activate '''переключаемся на 380*
oSht1.Cells(1, 1).Activate
Application.ScreenUpdating = True
'MsgBox Timer - iTimer & " с.", vbInformation
MsgBox "Выполнено", vbInformation
Set oRng = Nothing: Set oSht1 = Nothing: Set vl = Nothing
Set oSD = Nothing
End Sub

Sub HiddenRowArr()
Dim oSD As Object, arr(), x As Long
Dim oSht1 As Worksheet, oRng As Range
Dim iCore As Long    ''' коректор стартовой позиции строк
Dim sRows As String  ''' строки для скрытия
'Dim iTimer
'iTimer = Timer
Set oSD = CreateObject("Scripting.Dictionary"): oSD.comparemode = 1
  With ActiveWorkbook 
    For Each vl In .Worksheets: If vl.Name Like "380*" Then Set oSht1 = .Sheets(vl.Name)
    Next
    If oSht1 Is Nothing Then MsgBox "Листа 380* нет в файле, досрочное завершение работы", vbCritical: Exit Sub

    With .Sheets("Лист1") ''' c этого листа отбираем данные для дальнейшего анализа
      .Activate: .Cells(1, 1).Select
      arr = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    For x = LBound(arr) To UBound(arr):  If Not oSD.exists(arr(x, 1)) Then oSD.Add arr(x, 1), 0
    Next x
    Erase arr
    
    ''' работаем с листом 380* загрузка данных в массив и дальнейшее скрытие строк
  Application.ScreenUpdating = False
    ''' начинаем загрузку с 1-й строки (откоректировать) при необходимости
    Set oRng = oSht1.Range(oSht1.Cells(1, 6), oSht1.Cells(Rows.Count, 6).End(xlUp))
      iCore = oRng(1).Row - 1            '''корректировка строки в массиве для скрытия
      arr = oRng.Value2
      For x = LBound(arr) To UBound(arr) '''цикл по массиву из поля F листа 380*
        If Not IsEmpty(arr(x, 1)) Then
            If oSD.exists(arr(x, 1)) Then
                sRows = sRows & x + iCore & ":" & x + iCore & "," '''запись строк для скрытия
                ''' такая странная конструкция нужна для обхода ошибки Run-time error 1004
                ''' Она возникает при слишком длинной записи строк в переменную sRows
                ''' В момент выполнения .EntireRow.Hidden = True
                If x / 8 = x \ 8 Then   '''скрываем строки частями
                  If Len(sRows) > 0 Then
                      oSht1.Range(Left(sRows, Len(sRows) - 1)).EntireRow.Hidden = True
                      sRows = vbNullString
                  End If
                End If
            End If
        End If
      Next x
      Erase arr
      If Len(sRows) > 0 Then: oSht1.Range(Left(sRows, Len(sRows) - 1)).EntireRow.Hidden = True
  End With
  
oSht1.Activate
oSht1.Cells(1, 1).Activate
Application.ScreenUpdating = True
'MsgBox Timer - iTimer & " с.", vbInformation
MsgBox "Выполнено", vbInformation
Set oRng = Nothing: Set oSht1 = Nothing: Set vl = Nothing
Set oSD = Nothing: sRows = vbNullString
End Sub 

If x / 8 = x \ 8 Then   '''скрываем строки частями
    If Len(sRows) > 0 Then
         oSht1.Range(Left(sRows, Len(sRows) - 1)).EntireRow.Hidden = True
         sRows = vbNullString
    End If
End If

If Len(sRows) > 246 Then '''скрываем строки частями 
     oSht1.Range(Left(sRows, Len(sRows) - 1)).EntireRow.Hidden = True
     sRows = vbNullString
End If