こんばんは。
すでに回答がでていますが、
参考までにサンプルコードを作ってみました。
'======標準モジュールに記述=========================================
Sub test()
On Error GoTo Err_
Dim c As Object
Dim myKey As String
Dim myRange As Range
Dim UnionRange As Range
Dim fAddress As String
Set myRange = Range("A1", Cells(Rows.Count, "A").End(xlUp))
myKey = "■"
With myRange
Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByColumns, MatchByte:=False)
If Not c Is Nothing Then
fAddress = c.Address
Do
If UnionRange Is Nothing Then
Set UnionRange = c
Else
Set UnionRange = Union(c, UnionRange)
End If
Set c = .FindNext(c)
If c.Address = fAddress Then Exit Do
Loop
End If
UnionRange.EntireRow.Insert
End With
Bye_:
Set myRange = Nothing
Set UnionRange = Nothing
Set c = Nothing
Exit Sub
Err_:
MsgBox Err.Description, vbCritical
Resume Bye_
End Sub
お礼
ありがとうございます。 解決しました!