エクセルで数字の下１桁を見て並び替える

質問

エクセルで下記の様な数字が並んでいます。
A列の下１桁の数字は上から順に増えていて、ある数字で１に戻りまた増えています。
その数字は毎回同じではなく、６までの場合もあれば１０までの場合もあります。
下記の例では上から６行、次は４行、次は７行と下１桁の数字によってグループ分け出来ますよね？
それで上から６行目までのB列の値（４６２～５３０）をコピーしてSheet2のA1から横方向に並べます。
その次は７行目から１０行目までのB列の値（３５６～４８７）をコピーしてSheet2のA2から横方向に並べます。
その次も同じように並べます。

Ｂ列が空欄の場合もありますが、その場合はそのままSheet2にも空欄のセルを作ります。
１グループ全部のB列が空欄でもそのままSheet2に空欄の行を作ります。

この動作をマクロで出来る式を教えて頂けないでしょうか？

A列　　　　　　　　　　B列
0213240101 　　　 462
0213240102　　　 387
0213240103　　　 556
0213240104　　　 585
0213240105　　　 536
0213240106　　　 530
0213240201　　　 356
0213240202　　　 632
0213240203　　　 486
0213240204　　　 487
0213240301　　　 586
0213240302　　　 670
0213240303　　　 619
0213240304
0213240305　　　 645
0213240306　　　 487
0213240307　　　 651
0213240401
0213240402
0213240403
0213240501　　　 455
0213240502　　　 623
0213240503　　　 411

Sheet2
A列　　　B列　　　　C列　　　D列　　　　E列　　　　F列　　　G列
462　　　 387　　　 556　　　 585　　　 536　　　 530
356　　　 632　　　 486　　　 487
586　　　 670　　　 619　　　 　　　 　　　 645　　　 487　　　 651　　　

455　　　 623　　　 411

回答No.1

tom04 · ベストアンサー

こんばんは！
一例です。

標準モジュールにコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, k As Long, cnt As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
cnt = i
Do While wS1.Cells(cnt, 1) + 1 = wS1.Cells(cnt + 1, 1)
cnt = cnt + 1
Loop
Range(wS1.Cells(i, 2), wS1.Cells(cnt, 2)).Copy
wS2.Activate
k = k + 1
wS2.Cells(k, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
i = cnt
Next i
End Sub

※　各グループは連番になっているという前提です。
（下1桁という判断ではありません）

こんな感じではどうでしょうか？m（_ _）m

お礼

すみません、私のやり方が間違っていました。
ちゃんと思い通りに出来ました。
素晴らしいです、ありがとうございました。

補足

回答ありがとうございました。

マクロを実行しましたが、Sheet2のA1から下方向に、ペーストされてしまいます。
どこを修正すれば良いのでしょうか？

私の説明不足でした、下１桁ではなく右端の数字が１～１０や１～１５までなどの場合は下２桁までが続いてることになりますよね。
すみません、再度宜しくお願い致します。