文字列を検索しその列をコピーする(VBA)

質問

よろしくお願いします。

OS：WINDOWS 2000 PRO
環境：OFFICE 2003

エクセルのVBAについての質問です。

A列には数値コードが入っています。
そのコードは"1"と"2"に分類されてます。
マスターはSHEET1で、このマスターから
コード1はSHEET2に、
コード2はSHEET3に
振り分けたいのですが、どうもうまくいきません・・・
A列にはコード"1" "2"以外に空白セルが存在します。
空白セルは無視したい。。。
それとこのデータはDBから抽出するのですが、
抽出したデータは規則性はありません。
抽出するごとに"1"と"2"と"空白"はランダムなので、
LOOP等のマクロを調べてやってみたのですが、出来なくて週末になってしまいました。

A列からコード1とコード2を検索して、
ヒットしたコードの行ごと各SHEETにコピーして、
なおかつ各シートA列の入力されていない一番下の
セルにコピーしたいのですが、検索でヒットした
上から順番に。。。

これをLOOPと組合わせれば、各シートにコピーするのは
問題ないような気がします。。。

Sub AAA_BBB()
.Copy Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
End With
End Sub

LOOP等で上記の条件を満たせる方法はないでしょうか。

ご教示を、よろしくお願いします。

回答No.1

masa_019 · ベストアンサー

こんにちは。
For -Eachを使ってやってみました。
各シートの1行目はタイトル行になっているものとします。

Sub test()
Dim rng As Range
With Sheets("SHEET1")
For Each rng In _
Range(.Cells(1, 1), .Cells(.Range("A65536").End(xlUp).Row, 1))
If rng.Text = "コード1" Then
rng.EntireRow.Copy _
Sheets("SHEET2").Range("A65536").End(xlUp).Offset(1)
ElseIf rng.Text = "コード2" Then
rng.EntireRow.Copy _
Sheets("SHEET3").Range("A65536").End(xlUp).Offset(1)
End If
Next
End With
End Sub

お礼

初心者相手にご回答いただき感謝に耐えません。
もちろん、解決いたしました！
ありがとうございます。

回答No.2

Wendy02

こんばんは。

タイトル行は、Sheet1, Sheet2, Sheet3 にあるという前提にしないと、このコードはうまく行きません。最初のマスターのシートは、オートフィルタを使って抽出しています。これで参考にしてみてください。なお、コードは、myCodeのところを増やし、myShtsの中も、同じ数だけシートも増やせば、さらに増えても、ループは可能です。

'-----------------------------------------
Sub Sort_OtherSheetPaste()
　 Dim myShts() As Variant
　 Dim myCode() As Variant
　 Dim i As Integer

　 myCode = Array("1", "2") 'コード
　 myShts = Array("Sheet2", "Sheet3") 'ペーストされるシート
　 Application.ScreenUpdating = False
　 'マスターのシート
　 With Worksheets("Sheet1").Range("A1").CurrentRegion

　　　For i = LBound(myCode()) To UBound(myCode())
　　　　 .CurrentRegion.AutoFilter Field:=1, Criteria1:=myCode(i)
　　　　 .Offset(1).Resize(.Rows.Count - 1).Copy Worksheets(myShts(i)).Range("A65536").End(xlUp).Offset(1)
　　　Next i
　　　.AutoFilter
　 End With

　 Application.ScreenUpdating = True
End Sub

なお、マクロの実行のダブりの検査は、現在のコードではなされていません。

お礼

解決できました。
ありがとうございます。