Public Sub insStr()
Dim i As Integer
Dim j
Dim rng1 As Range
Dim fName As String, bkStartName As String
Const lName As String = "Лист1"
Const startRow As Integer = 1

fName = "False"
bkStartName = ThisWorkbook.Name
With Worksheets(lName)
    Set rng1 = Range("A5:G29")
    j = .Cells(4, 1).Font.Color
End With

fName = Application.GetOpenFilename

If fName <> "False" Then
Workbooks.Open Filename:=fName
With ActiveWorkbook.Worksheets(lName)
i = .Cells(Rows.Count, 1).End(xlUp).Row

For i = i To startRow Step -1
    If .Cells(i, 1).Font.Color = j Then
        .Cells(i + 1, 1).Select
        Selection.Resize(rng1.Rows.Count).EntireRow.Insert Shift:=xlShiftDown
        rng1.Copy Destination:=Selection
    End If
Next i

End With
ActiveWorkbook.Close
End If
Workbooks(bkStartName).Activate
End Sub