質問番号：1416654240

特定のキーワードに一致したら、そのキーワードのある行と、そのキーワードから上に2行を含め、合計3行をSheet2に移動させたい。 今、セルE13に「AAAあいうえおBBB」と入力されております。 また、セルE71には「CCCあいうえおDDD」と入力されております。 この状態におきまして。 E列にもし「あいうえお」とある文字列が含まれていた場合、その文字列を含む行と、その行のちょうど真上の2行、合わせて3行を、コピーか切り取りして、Sheet2にどんどん移動させていきたいのです。 そのような関数やマクロ等ありましたら、お教えいただけないでしょうか。 サンプルファイルはこちら http://xfs.jp/sFV2I7 に置きました。 よろしくお願い致します。

Option Explicit

Sub main()

Dim LastRow As Long
Dim CopyRow As Long
Dim lp As Long

	Worksheets(2).Cells.Clear
	LastRow = Me.Range("E" & Rows.Count).End(xlUp).Row
	CopyRow = 1

	For lp = 3 To LastRow
		If InStr(Range("E" & lp), "あいうえお") > 0 Then
			Me.Range(lp - 2 & ":" & lp).Copy
			Worksheets(2).Range(CopyRow & ":" & CopyRow + 2).PasteSpecial
			CopyRow = CopyRow + 3
		End If
	Next lp

End Sub

ダウンロードURL

http://firestorage.jp/download/26e13ee2b3f281f36c4932697f2f3b054cca5f01