特定の行を選択して別のシートにコピーするマクロ

Question

指定した行と、
特定の文字(複数)がある行を
全て選択し、別のシートにコピーする
マクロをお教えいただけませんか？

選択したい行は(同じシートで)
　必ず３行目と、
　A列に『ABC』、『DEF』という文字がある全ての行です。

このようなマクロはどのように作ればいいでしょうか？
マクロに詳しい方、お知恵をお貸し頂けませんでしょうか？

tom04 · Accepted Answer

補足を読みました。
値としてSheet2に表示すれば良い訳ですね。

前回のコードに手を加えるとすると

Sub Sample4()
 Dim lastRow As Long, wS As Worksheet
 Set wS = Worksheets("Sheet2")
 wS.Cells.Clear
 With Worksheets("Sheet1")
 lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
With .Rows(3 & ":" & lastRow)
.AutoFilter field:=1, Criteria1:="*ABC*", Operator:=xlOr, Criteria2:="*DEF*"
 .SpecialCells(xlCellTypeVisible).Copy
 wS.Activate
 ActiveSheet.Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues
 End With
 .AutoFilterMode = False
 End With
 End Sub

こんな感じでしょうか！

尚上記方法はオートフィルタでやっていますので、データ量が多くない場合は
For～Nextでループさせても良いと思います。
参考程度でそのコードは

Sub Sample5()
    Dim i As Long, lastCol As Long, wS As Worksheet
    Set wS = Worksheets("Sheet2")
    wS.Cells.Clear
    With Worksheets("Sheet1")
        lastCol = .UsedRange.Columns.Count
    wS.Range("A1").Resize(, lastCol).Value = .Range("A3").Resize(, lastCol).Value
    For i = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
        If InStr(.Cells(i, "A"), "ABC") > 0 Or InStr(.Cells(i, "A"), "DEF") > 0 Then
            wS.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, lastCol).Value = _
                .Cells(i, "A").Resize(, lastCol).Value
        End If
    Next i
    End With
End Sub

でも同様の結果になると思います。m(_ _)m

tom04 · Answer

No.1・2です。
たびたびごめんなさい。

いっそのこといままでのコードはきれいに削除して↓のコードに変更してください。
最終列は関係なく、行すべてをコピー＆ペーストするようにしてみました。
※　最終行は今まで通りA列で取得しています。

Sub Sample3()
 Dim lastRow As Long, wS As Worksheet
 Set wS = Worksheets("Sheet2")
 wS.Cells.Clear
 With Worksheets("Sheet1")
 lastRow = .Cells(Rows.Count, "A").End(xlUp).Row    '←A列で最終行取得
 With .Rows(3 & ":" & lastRow)  '←3行目～最終行まですべての行
    .AutoFilter field:=1, Criteria1:="*ABC*", Operator:=xlOr, Criteria2:="*DEF*"
    .SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
End With
 .AutoFilterMode = False
 End With
 End Sub

※　A列最終行さえ間違っていなければこれで大丈夫だと思います。m(_ _)m

tom04 · Answer

No.1です。
補足を読ませていただきました。

前回はA3セルを指定してオートフィルタをかけていましたので、
もし2行目にもデータがある場合には2行目が項目行となってしまいますので、
不要な行までコピー＆ペーストしていたと思います。

そこで、今回はA3セル以降最終行までを範囲指定してみました。
尚、コード内で最終列取得は3行目で行っていますので、3行目は最終列まで何らかのデータが入っていない場合
データがある列までしかコピー＆ペーストできません。
前回同様↓のコードに変更してマクロを実行してみてください。

Sub Sample2()
 Dim lastRow As Long, lastCol As Long, wS As Worksheet
 Set wS = Worksheets("Sheet2")
 wS.Cells.Clear
 With Worksheets("Sheet1")
 lastRow = .Cells(Rows.Count, "A").End(xlUp).Row    '←A列で最終行取得
 lastCol = .Cells(3, Columns.Count).End(xlToLeft).Column    '←3行目で最終列取得
 With .Range(.Cells(3, "A"), .Cells(lastRow, lastCol))
    .AutoFilter field:=1, Criteria1:="*ABC*", Operator:=xlOr, Criteria2:="*DEF*"
    .SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
End With
 .AutoFilterMode = False
 End With
 End Sub

尚、
＞例えばK7までデータがあるのにもかかわらず
というように最終列が判っている場合は
＞lastCol
の宣言は不要で
＞With .Range(.Cells(3, "A"), .Cells(lastRow, lastCol))
の行を
＞With .Range(.Cells(3, "A"), .Cells(lastRow, "K"))
に変更しても大丈夫だと思います。

今度はどうでしょうか？m(_ _)m

tom04 · Answer

こんばんは！
＞A列に『ABC』、『DEF』という文字がある全ての行です
すなわち「ABC」または「DEF」が含まれている行すべてとします。

標準モジュールです。
Sheet1のデータをSheet2のA1セル以降に表示するようにしてみました。

Sub Sample1()
    Dim lastRow As Long, lastCol As Long, wS As Worksheet
    Set wS = Worksheets("Sheet2")
    wS.Cells.Clear
    With Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(3, Columns.Count).End(xlToLeft).Column
        .Range("A3").AutoFilter field:=1, Criteria1:="*ABC*", _
            Operator:=xlOr, Criteria2:="*DEF*"
        Range(.Cells(3, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy _
            wS.Range("A1")
        .AutoFilterMode = False
    End With
End Sub

こんな感じではどうでしょうか？

特定の行を選択して別のシートにコピーするマクロ

補足を読みました。

No.1・2です。

この回答への補足

No.1です。

こんばんは！

この回答への補足

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング