マクロ 選択範囲及び切り取り＆貼り付けについて教えてください。

質問

(1)sheet1のＡ列からＨ列までデータが入っています。
(2)検索機能を使って発見されたセル（検索されるデータはＡ列にのみ入っています。）からＡ～Ｈ列のデータが入っている最終行まで選択し切り取り。（場合によっては検索を２回してから選択範囲を決めます）
(3)sheet2のＡ２へ貼り付け

(1)～(3)の作業をsheet7まで繰り返します。
マクロの記録を行うと選択範囲が指定され別のデータの時にも前と同じ範囲しか指定できません。

例
sheet1検索ち→発見されたセル（この場合Ａ３）からＡ～Ｈ列の最終行（Ａ９）選択及び切り取り→sheet2のＡ２へ貼り付け→検索ち→文字が縦に２回続いている場合は次を検索→発見されたセル（この場合Ａ６）からＡ～Ｈ列の最終行（Ｈ８）選択及び切り取り→sheet3のＡ２へ貼り付け
sheet1　　　→　　　　　sheet2　　　→　　　sheet3
　ＡＢＣＤＥＨＧＨ　　　　ＡＢＣＤＥＨＧＨ　　ＡＢＣＤＥＨＧＨ
１ち　あいうえおか　　１　　　　　　　　　　１
２ひあいう　えおか　２ちあい　い　うえ　２ちあいうえお　か
３ちあい　い　うえ　　３　あいうえお　か　３ひあいうえおかき
４ゆあいうえお　か　４ちあいうおかき　　４ちあ　うえおき　
５ちあいうおかき　　５ゆあいうえおかき　
６　あいうえおかき　６ちあいうえお　か　
７ちあいうえお　か　７ひあいうえおかき
８ひあいうえおかき　８ちあ　うえおき　
９ちあ　うえおき　　
＊実際のデータは２０００行ぐらいデータが入っています。
＊見えずらくてすみません。

回答No.3

mt2008 · ベストアンサー

最初に切り取り開始行を検索して配列にでも入れておき、ループを回して、切り取り開始行～最終行までのコピーを各シートに貼り付けると言う処理になるかと思います。
サンプルコードを書きますので、Step実行でもして何をしているか確認して見てください。

Sub sample()
Dim nMaxRow As Long
Dim nLoop As Long
Dim nSheet As Long
Dim nCount As Long
Dim nStartRow() As Long '切り取り開始行を入れる配列

Sheets("Sheet1").Select

'*** A2から順に見て行き、選択開始位置を求める
nMaxRow = ActiveSheet.UsedRange.End(xlDown).Row 'データのある最終行

nCount = 0
For nLoop = 2 To nMaxRow
　'セルの値が検索文字と同一かつ、次のセルの値は検索文字と不一致なら切り取り開始行
　If StrComp(Cells(1, 1), Cells(nLoop, 1)) = 0 And StrComp(Cells(1, 1), Cells(nLoop + 1, 1)) <> 0 Then
　　ReDim Preserve nStartRow(nCount) '配列を広げる
　　nStartRow(nCount) = nLoop '切り取り開始行を代入
　　nCount = nCount + 1
　　If nCount > 5 Then Exit For 'Sheet7までなのでこれ以上の切り取りは不要
　End If
Next nLoop

'*** 検索文字が無かった場合
If nCount = 0 Then
　MsgBox ("検索文字「" & sSearchWord & "」なし")
　End
End If

'*** Sheet2～7にデータを張りつけ
For nSheet = 0 To UBound(nStartRow())
　'Sheet1の切り取り開始行から最終行までを選択してコピー
　Sheets("Sheet1").Select
　Range(Cells(nStartRow(nSheet), 1), Cells(nMaxRow, 8)).Select
　Selection.Copy

　'Sheet2～7のA2に貼り付け
　Sheets("Sheet" & nSheet + 2).Select
　Range("A2").Select
　ActiveSheet.Paste
Next nSheet

End Sub

回答No.2

imogasi

マクロの記録で勉強しているレベルでは出来ないでしょう。
質問がわかりにくい。
＞(1)～(3)の作業をsheet7まで繰り返します。
などはどういう意味なのか。
検索対象のシートと、結果を出すシートは、分けて説明しないと
混乱する。
Sheet2などは検索結果を出す（置く）シートなのでは。Sheet3はどういうものか
どうもSheet1－Sheet7までシートがあってこれが検索対象のシート。
そして検索結果を出すシートは例えばSheet8以後。そしてシートのA2しか使わない。
Sheet8以後は、Sheet1の中に１行の検索文字列が見つかると、Sheet8以後の１つのシートに結果を出す。（シートを変える）。そしてSheet7まで同じような操作を続ける。
ーー
同じ文字列が沢山の行で有るとSheet8以下シートが増えるがよいのか。
文字列を変えて質問の処理をすることは無いのか。その場合以前の文字列で検索した結果のシートはどうするのか（そのまま置いておいて、後にシートを増やすのか、シートを削除するのか）
ーー
結果を出すシートのA2以外のセルは内容なしでよいのか。
多分そう送ではなかろう。その点は？
ーーー
参考になりそうなことを１つ
Sub test01()
Dim sh As Worksheet
For Each sh In Worksheets(Array("Sheet1", "Sheet3", "Sheet4"))
MsgBox sh.Name '本来はここに各１シート分の処理のコードを入れる
Next
End Sub
これの応用で、選択したシートだけを処理対象に出来る。
ーー
FindメソッドはFindNextとの連携がVBA初心者には難しい。
初心者のうちは、A列全行総当りで探す方法もある。
検索の終わりも
A.オジェクトがNothing
B。最初に見つかった行に回帰
で見つける方法が有る。
WEBで「VBA　Find　FindNext」で照会して勉強のこと。
１シートで、次々検索する操作をマクロの記録を撮るのも参考になる。
ーー
他に、結局何がわからないのか、ブレークダウンして質問のこと。

回答No.1

n-jun

Ａ列のセル値を上から順番に見ていって、”ち”が見つかったらカウントを入れる。
カウントが２になった時、その行から最終行までを切り取り別シートへ移動する。
ただし”空白”だった場合はカウントを０にする。

とても鈍行な方法ですけど。