Sub Добавить()
'
' Добавить Макрос
'

         Dim sh As Worksheet, sb As Worksheet
         Set sh = Sheets("Добавить оборудование в базу")
         Set sb = Sheets("База")

         If IsEmpty(sh.Range("B16")) And IsEmpty(sh.Range("B17")) And IsEmpty(sh.Range("B18")) Then
             MsgBox "Нечего вносить в базу"
         Else

             Application.ScreenUpdating = False
                  
             If Not IsEmpty(sh.Range("B16")) Then
                 ins sb, sh: sh.Range("B16:D16").Copy sb.Range("A2")
             End If

             If Not IsEmpty(sh.Range("B17")) Then
                 ins sb, sh: sh.Range("B17:D17").Copy sb.Range("A2")
             End If

             If Not IsEmpty(sh.Range("B18")) Then
                 ins sb, sh: sh.Range("B18:D18").Copy sb.Range("A2")
             End If

             Application.ScreenUpdating = True
         End If

End Sub

Private Sub ins(sb, sh)
         sb.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         sh.Range("B14:D14").Copy sb.Range("D2")
         sh.Range("E13").Copy sb.Range("G2")
End Sub

Sub Добавить()
     Dim sh As Worksheet, sb As Worksheet
     Set sb = Sheets("База")
     Set sh = Sheets("Добавить оборудование в базу"): With sh
         If IsEmpty(.[B16]) And IsEmpty(.[B17]) And IsEmpty(.[B18]) Then
             MsgBox "Нечего вносить в базу"
         Else
             If Not IsEmpty(.[B16]) Then ins sb, sh: .[B16:D16].Copy sb.[A2]
             If Not IsEmpty(.[B17]) Then ins sb, sh: .[B17:D17].Copy sb.[A2]
             If Not IsEmpty(.[B18]) Then ins sb, sh: .[B18:D18].Copy sb.[A2]
         End If: End With
End Sub

Private Sub ins(sb, sh)
     sb.Rows(2).Insert: sh.[B14:D14].Copy sb.[D2]: sh.[E13].Copy sb.[G2]
End Sub

Sub Добавить_оборудование_в_базу()
     Dim lr&, i&, arr, arr1, a$, aa$
     With Sheets("Добавить оборудование в базу")
         lr = .Cells(4, "B").End(xlDown).Row
         If lr < 5 Then Exit Sub
         arr = .Range("B5:D" & lr).Value
         arr1 = .Range("B3:D3").Value
         aa = .Range("E2").Value
         a = .Range("D3").Hyperlinks(1).Address
     End With
     With Sheets("База")
         lr = .Cells(Rows.Count, "A").End(xlUp).Row
         .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(arr), 3) = arr
         .Range("D" & lr + 1).Resize(UBound(arr), 3) = arr1
         .Hyperlinks.Add Anchor:=.Range("F" & lr + 1).Resize(UBound(arr)), Address:=a
         .Range("G" & lr + 1).Resize(UBound(arr)) = aa
     End With
End Sub