トップ　>　汎用コード　>　特定データの下(右)に行(列)を挿入

Sub Insert_RCs_BasedOnData() '対象：アクティブシート
    Dim varArray   As Variant
    Dim v          As Variant
    Dim strAddress As String
    Dim rngFnd     As Range
    Dim rngUni     As Range
    
    varArray = Array("りんご", "リンゴ") '検索文字列
    
    For Each v In varArray
        Set rngFnd = Cells.Find(What:=v,  _
                                LookIn:=xlValues,  _
                                LookAt:=xlPart,  _
                                SearchOrder:=xlByRows,  _
                                MatchCase:=False,  _
                                MatchByte:=False) '検索　1周目「りんご」2周目「リンゴ」
        If Not rngFnd Is Nothing Then   '
            strAddress = rngFnd.Address '最初に検索一致したセルの番地格納
            If rngUni Is Nothing Then Set rngUni = rngFnd
            Do
                Set rngUni = Union(rngUni, rngFnd)  'セルを集合
                Set rngFnd = Cells.FindNext(rngFnd) '次の一致セルを検索
            Loop Until strAddress = rngFnd.Address  'セルのアドレスが一致したらループを抜ける
        End If
    Next
    
    If Not rngUni Is Nothing Then
        With rngUni
            If MsgBox("行挿入：はい　列挿入：いいえ", vbYesNo, "行を挿入しますか？") = vbYes Then
                Union(.Offset(1), .Offset(1)).EntireRow.Insert '行の挿入
            Else
                Union(.Offset(, 1), .Offset(, 1)).EntireColumn.Insert '列の挿入
            End If
        End With
    End If
End Sub