EXCEL で 数値別に その行を 別sheeｔの表に 貼り付けたい。

質問

一回のマクロで　移動できないでしょうか

＿＿＿＿＿＿＿＿＿＿＿＿＿
　　　　A　　　B　　　　　C　　　　　　　D
１　　日付　　コード　　仕入れ金額　　　数量
２　　10/2　　0098　　　　20　　　　　　　9
３　　10/2　　0008　　　　21　　　　　　　9
４　　10/3　　0128　　　　23　　　　　　　10
５　　10/4　　0098　　　　24　　　　　　　9
６　　10/9　　0128　　　　23　　　　　　　12

コード0098のデータ行を　sheet２　へ
コード0128のデータ行を　sheet３　へ
コード0008のデータ行を　sheet４　へ

コピーか　移動できないでしょうか？
よろしくお願いいたします。

回答No.2

Wendy02 · ベストアンサー

こんばんは。

こんなことかな？一応、コピーにしてあります。
コードには、抜け落ちがないものという前提にしてあります。

Sub TurnOverCodeClassifying()
　 Dim myCodes() As Variant
　 Dim c As Range
　 Dim Ret As Variant
　 Dim i As Long
　 Dim j As Integer
　 myCodes() = Array("0098", "0128", "0008")
　 With ActiveSheet
　　　'タイトル行の貼り付け
　　　For j = 2 To 4
　　　　 .Rows(1).Copy Worksheets("Sheet" & j).Rows(1)
　　　Next j
　　　For Each c In .Range("B2", Range("B65536").End(xlUp))
　　　　 On Error Resume Next
　　　　 Ret = WorksheetFunction.Match(c.Text, myCodes, 0)
　　　　 On Error GoTo 0
　　　　 If Ret <> Empty Then
　　　　　　i = Ret + 1
　　　　　　c.Offset(, -1).Resize(, 4).Copy _
　　　　　　Worksheets("Sheet" & i).Range("A65536").End(xlUp).Offset(1)
　　　　　　Ret = Empty
　　　　 End If
　　　Next c
　 End With
End Sub

お礼

ひえー！(◎∀◎)すごい！
いまやって見ました～～～できましたできました！！

ほんとにありがとうございました～～～
このコード見るのは初めてですわ～～

回答No.1

imogasi

＞数値別　とは　上記例では、コード別のことか。数量ごとか。
数量のことの場合、数量は段階別になるのか、数量は整数値で限られた種類なのか。
数量の種類だけ、シートに振り分けるのか。

それであれば、数量でソートして、数量が変わるごとにＳｈｅｅｔを変える（Ｓｈｅｅｔのインデックスを１増やす）すればよいと思う。
＞一回のマクロとは、１つのプロシージュアーのことか（１本のプログラム）。
移すのは、セルの値だけで良いのでしょう？

補足

はいコード別に　仕分けを　行いたいのですが

コピーする値は、行単位で　

すみません　わたし　初心者で　伝わらなかったらごめんなさい