EXCEL【ＶＢＥ】 範囲別にその行を別sheeｔの表に値だけを貼り付けたい。

先日 コードは特定した数値でしたが，今回は 条件に合う数値なんですが お願いします。
　　　　A　　　B　　　　　C　　　　　　　D
１　　日付　　コード　　仕入れ金額　　　数量
２　　10/2　　0098　　　　20　　　　　　　9
３　　10/2　　0180　　　　21　　　　　　　9
４　　10/3　　0128　　　　23　　　　　　　10
５　　10/4　　0089　　　　24　　　　　　　9
６　　10/9　　0123　　　　23　　　　　　　12

コード0099以下のデータ行を　sheet２　へ
コード0100～0149のデータ行を　sheet３　へ
コード0150以上のデータ行を　sheet４　へ

値だけを貼り付けできないでしょうか？
よろしくお願いいたします。

No.1 ベストアンサー 回答者： Wendy02 回答日時： 2005/10/31 19:28

takara_kujio様、こんばんは。

Wendy02です。

早速変更しましたので、お試しください。
＞コード0099以下のデータ行を　sheet２　へ
＞コード0100～0149のデータ行を　sheet３　へ
＞コード0150以上のデータ行を　sheet４　へ

前回、作っていて、そういうことになるのではないかなってフト思ったのが的中しました。（^^;　ちょっと変更してみました。変更する場合は、MatchLike()というところで、直してください。

'-------------------------------------------------
Sub TurnOverCodeClassifying2()
　 Dim c As Range
　 Dim Ret As Integer
　 Dim i As Long
　 Dim j As Integer
　 With ActiveSheet
　　　'タイトル行の貼り付け
　　　For j = 2 To 4
　　　 Worksheets("Sheet" & j).Range("A1").CurrentRegion.ClearContents
　　　　 .Rows(1).Copy Worksheets("Sheet" & j).Rows(1)
　　　Next j
　　　For Each c In .Range("B2", Range("B65536").End(xlUp))
　　　　 Ret = MatchLike(c.Value)
　　　　 If Ret > 0 Then
　　　　　　i = Ret + 1
　　　　　　c.Offset(, -1).Resize(, 4).Copy _
　　　　　　Worksheets("Sheet" & i).Range("A65536").End(xlUp).Offset(1)
　　　　　　Ret = 0
　　　　 End If
　　　Next c
　 End With
End Sub
'設定用
Private Function MatchLike(ByVal strArg As Long) As Integer
Dim i As Long
　 'ここで設定してください。
　 Select Case strArg
　 Case Is <= 99　'以下
　　 i = 1
　 Case 100 To 149　'～の間
　　 i = 2
　 Case Is >= 150　'以上
　　 i = 3
　 End Select
　 MatchLike = i
End Function
'-------------------------------------------------

この回答へのお礼

先日はどうもありがとうございました。
MatchLike っていうんですね～
VBEってすごいな～って思います。

この前の教えていただいたのを自分なりに直してやったも　だめで　お手上げでした。
（数を変えるだけ　笑）
これから　専門用語も私なりに覚えていかなくては・・・・
早速明日使ってみます。どうもありがとうございました～～

お礼日時：2005/10/31 22:27

No.2 回答者： imogasi 回答日時： 2005/10/31 20:53

コード少なくするため、VLOOKUPのTRUE型を使ってみました。

Sheet3からSheet4,5,6へ振り分ける例でやってみました。
Sheet3のI1:J3に
01
1002
1503
を作りました。（もしかしたら１００は９９、１５０は１４９が正しいかも。十分テストできなかった）質問例ではテスト済み。
Sub test02()
Dim l(4) '３段階区分なので４にしている
d = Range("A20").End(xlUp).Row '最終データ行を第２０行とする。
' MsgBox d
a = Array("sheet3", "sheet4", "Sheet5", "Sheet6") '3段階しかない場合の例、シート名
'----第１は元になるシート、その後は振り分ける段階に対応するシート名
'---書き出す各シートの第１行の１に初期化
For i = 1 To UBound(l)
l(i) = 1
Next i
'-----データ各行について振り分け
For i = 2 To d
n = Val(Worksheets(a(0)).Cells(i, "B"))
m = WorksheetFunction.VLookup(n, Range("i1:j3"), 2) 'I1:J3に段階表を作る(注）
'----元になるシートの行から、振り分け先のシートへセルの値をセット
Worksheets(a(m)).Cells(l(m), "A") = Worksheets(a(0)).Cells(i, "A")
Worksheets(a(m)).Cells(l(m), "B") = Worksheets(a(0)).Cells(i, "B")
Worksheets(a(m)).Cells(l(m), "C") = Worksheets(a(0)).Cells(i, "C") 'D列は省略
l(m) = l(m) + 1 '振り分けた先のシートの次に書き込む行を１段下へ
Next i
End Sub
各シートのA列は書式を日付にしておいてください。

この回答へのお礼

＜（もしかしたら１００は９９、１５０は１４９が正しいかも。十分テストできなかった）質問例ではテスト済み。
そうですそうです　＾＾；失礼しました。
早速明日会社で試して見ます。
ありがとうございました。

お礼日時：2005/10/31 22:18