Excelに関する質問です。特定の値を含む行全てを、別シートに移動させるマクロはないでしょうか。

Sheet1～Sheet6のE列に、データが並んでおります。この中から、Q3セルと一致するセルがあった場合、そのセルのある“行”を全て“コピー”し、Sheetに移すことは出来ないでしょうか。
宜しくお願い致します。

質問者からの補足コメント

• すみません。Q3はsheet1に有ります。移すsheetはsheet7に移したいです。移す行はA5セルにしたいです。宜しくお願い致します。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/02/16 12:55

• 行全てで5行目以降です。
  仰る通りsheet7の最終行に追加したいです。
  丁寧にありがとうございます。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/02/16 14:32

• 実行してみたところ、MyKey = Sheets("Sheet1").Range("Q3") '照合キー（各シート共通）のところで「インデックスが有効範囲にありません」と出てしまいます。どの様に解決したら良いでしょうか。ご教授ください。何から何まで本当に申し訳ありません。

    補足日時：2020/02/16 15:22

• sheet1～順番に1号機、2号機、3号機、自動倉庫、電気、その他にしてあります。

    補足日時：2020/02/17 08:25

No.1 回答者： Qchan1962 回答日時： 2020/02/16 12:31

こんにちは、

＞Q3セルと一致するセルがあった場合
どこのシートのQ3セル？

＞Sheetに移すことは出来ないでしょうか
どこのシート？移す行は？

No.2 回答者： Qchan1962 回答日時： 2020/02/16 13:24

＞移す行はA5セルにしたいです。

行全てだと思いますが、、、
sheet7の5行目と言う事でしょうか？
Sheet1～Sheet6に複数該当行があった場合、最後に該当した行が上書きされてしまいますが？良いのですか？

sheet7の5行目以降の最終行に追加などで回避できますが、、いかがですか？

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2020/02/16 14:27

＃１，２です。

離れるので、参考マクロを掲示します。
移すは、元の行を削除すると言う事でしょうか、もしそうであれば、ループのやり方など変更が必要です。
サンプルは、sheet7の5行目以降の最終行に追加して行きます。
箇条書きを付けましたので、確認してください。

Option Explicit
Sub Sample()
Dim i As Long, j As Long　'カウント用変数
Dim TgtRow As Long, n As Long　'最終行取得用変数
Dim Sht_name As String, TgtSht_Name As Variant 'シート名格納用変数
Dim TgtSht As Worksheet　'ブック内シートオブジェクト用変数
Dim MyKey As Variant　'照合キー格納用変数
　　MyKey = Sheets("Sheet1").Range("Q3") '照合キー（各シート共通）
　　TgtSht_Name = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")　'シートを配列で指定
　　For i = 0 To UBound(TgtSht_Name)　'指定したシートを順次実行
　　　　For Each TgtSht In ActiveWorkbook.Worksheets 'ブックの中のシートを1つずつ確認
　　　　　　If TgtSht.Name = TgtSht_Name(i) Then　'ブックのシート名と設定した対象シート名が同じなら
　　　　　　　　n = TgtSht.Cells(Rows.Count, 5).End(xlUp).Row　'対象シートのE列の最終行を取得
　　　　　　　　TgtRow = Sheets("Sheet7").Cells(Rows.Count, 1).End(xlUp).Row　'書き出しシートのA列の最終行を取得
　　　　　　　　If TgtSht.Name = "Sheet1" And TgtRow < 5 Then TgtRow = 4　'照合キーのあるSheet1、3行目より上の行を除外
　　　　　　　　For j = 4 To n　'対象シートの最終行までループ
　　　　　　　　　　If MyKey = TgtSht.Cells(j, 5) Then　'照合キーと対象シートのE列対象行の値が一致したら
　　　　　　　　　　　　TgtSht.Rows(j).Copy Destination:=Sheets("Sheet7").Rows(TgtRow + 1)　'メイン処理、対象シートの行全てをコピーSheets("Sheet7")のA列の最終行の下行に全てペースト
　　　　　　　　　　End If
　　　　　　　　Next j　'対象シートE列最終行までループ
　　　　　　End If
　　　　Next TgtSht　　　 'ブック内シートループ
　　Next i　　'設定シート名ループ
End Sub

No.4 回答者： Qchan1962 回答日時： 2020/02/16 21:52

こんばんは、

＞MyKey = Sheets("Sheet1").Range("Q3") '照合キー（各シート共通）のところで「インデックスが有効範囲にありません」

Sheet1～Sheet6と書いてありますが、それは、シート名ですか？

TgtSht_Name = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")　'シートを配列で指定
TgtRow = Sheets("Sheet7").Cells(Rows.Count, 1).End(xlUp).Row
TgtSht.Rows(j).Copy Destination:=Sheets("Sheet7").Rows(TgtRow + 1)
にも影響します。

各、シート名を教えてください。
シート名は、画像参照（画像は"　Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6""Sheet7"）

この回答へのお礼

シート名を変更してみたら上手くいきました。本当にありがとうございました。

お礼日時：2020/02/17 08:30