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

質問

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

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

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

回答No.4

tom04 · ベストアンサー

補足を読みました。
値として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様、何度もご回答いただき、有難うございます。

お教え頂いたSample4のマクロのwS.Cells.Clearの部分を
削除することでうまく貼り付けが可能になりました。

最後までお付き合い頂き本当に有難うございました。

回答No.3

tom04

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様、ご回答ありがとうございます。
今回、お教えいただいたマクロで
私のやりたかったことが可能になりました。

あと、すいません、後出しみたいで申し訳ないのですが、
このマクロにコピー先のシートに
値のみ貼り付けを行う記述を追加可能でしたら
お教えいただけませんでしょうか？

コピー先のシートに罫線やセルの塗りつぶしで
色分け分類をしていましたので・・・。
（本当に申し訳ありません）

回答No.2

tom04

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

回答No.1

tom04

こんばんは！
＞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

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

補足

tom04様ご回答有難うございます。
お教えいただいたマクロを
実際に、検討していましたので返答が遅くなり申し訳ありませんでした。

おっしゃる通り、選択したいのは
A列に「ABC」または「DEF」が含まれている行すべてです。
（A3行は必ず含めたい）

さて、お教え頂いたマクロですが
実際に処理をしたいテキストファイルを読み込んで
マクロを実行したのですが、
検索文字があるA列のみのコピーになってしまい、
行全体のコピーとなっていませんでした。
また、A3を含む行はコピーされませんでした。

そこで、手入力で簡単なシートを作ってマクロを実行した所
私が選択したい行がコピーされていましたが、
例えばK7までデータがあるのにもかかわらず
コピー先を見るとA7～E7までしかコピーされない状態でした。
その後、値の入っているセルの数を変えて試しましたが、
コピーされる行数が変わり、その法則性もよく分かりませんでした。
シートに入力されている値によってコピーのされ方が変わるのでしょうか？

他に、いいやり方があればアドバイスをお願いします。