Sub MySaveName1()
    Dim sName As Variant
    sName = Application.GetSaveAsFilename(ThisWorkbook.Path & "\" & Range("b2") & ".xlsm", "Excel files (*.xlsm),*.xlsm")
    On Error Resume Next
    If sName <> False Then ThisWorkbook.SaveAs sName
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [a1:a2]) Is Nothing Then
        Range("a6").EntireRow.Hidden = ([a1] = 0 Or [a2] = 0)
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("a1") <= 0 Or Range("a2") <= 0 Then
        Range("a6").EntireRow.Hidden = True
        Else
        Range("a6").EntireRow.Hidden = False
    End If 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("a3") <= 0 And Range("a4") <= 0 Then
        Range("a7").EntireRow.Hidden = True
        Else
        Range("a7").EntireRow.Hidden = False
    End If 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)    
    If Target.Address = [c35].Address Then Range("d35") = ""
    If Target.Address = [c36].Address Then Range("d36") = ""   
    If Target.Address = [c37].Address Then Range("d37") = "" 
    ... и таких зависимых списков до 30шт.
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d
Set d = Union(Range("Имя1"), Range("Имя2"))
Names.Add Name:="ИмяДиапазона", RefersTo:=d
    If Target.Address = [a1].Address Then
        If Target.Value = "Коала" Then    
            Range("ИмяДиапазона").EntireRow.Hidden = True            
        Else
            Range("ИмяДиапазона").EntireRow.Hidden = False            
        End If
    End If
End Sub

Sub СоздатьИмяДиапазона()
    Dim d
    Set d = Union(Range("Имя1"), Range("Имя2"))
    Names.Add Name:="ИмяДиапазона", RefersTo:=d
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = [a1].Address Then
        If Target.Value = "Коала" Then    
            Range("ИмяДиапазона").EntireRow.Hidden = True            
        Else
            Range("ИмяДиапазона").EntireRow.Hidden = False            
        End If
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim x 
   x = Range("a1" ;) 
 
   If x = "Коала" Then 
       If Target.Address = [a1].Address Then 
          Range("e2" ;) .Copy 
          Range("a2" ;) .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
          Range("e6" ;) .Copy 
          Range("a3" ;) .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
       End If 
   End If
 
   If x = "Маяк" Then 
       If Target.Address = [a1].Address Then 
          Range("e3" ;) .Copy 
          Range("a2" ;) .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
          Range("e7" ;) .Copy 
          Range("a3" ;) .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
       End If 
   End If
 
   If x = "Пингвины" Then 
       If Target.Address = [a1].Address Then 
          Range("e4" ;) .Copy 
          Range("a2" ;) .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
          Range("e8" ;) .Copy 
          Range("a3" ;) .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _ 
          SkipBlanks:=False, Transpose:=False 
       End If 
   End If 

 Application.CutCopyMode = False 
End Sub