B2:
=IFERROR(INDEX($A$1:$A$21,SMALL(IF(LEFT($A$2:$A$21)="1",ROW($A$2:$A$21),""),ROW()-1)),"")
向下複製公式到B3:B20。
C2:
=IFERROR(INDEX($A$1:$A$21,SMALL(IF(LEFT($A$2:$A$21)="2",ROW($A$2:$A$21),""),ROW()-1)),"")
向下複製公式到C3:C20。
D2:
=IFERROR(INDEX($A$1:$A$21,SMALL(IF(LEFT($A$2:$A$21)="3",ROW($A$2:$A$21),""),ROW()-1)),"")
向下複製公式到D3:D20。

問問題之前
先把圖片搞定吧

圖片已經搞定
樓下也已經提供解答(不用寫 VBA)

vba參考一下囉
Sub zxc()

sheet1.Range("c2:z5000").ClearContents
mx = sheet1.Range("a1").End(xlDown).Row '
c1 = 2: d1 = 2: e1 = 2

For x = 1 To mx
dn = Left(Range("a" & x + 1), 1) '取左邊第1碼
If dn = 1 Then c = 10
If dn = 2 Then c = 20
If dn = 3 Then c = 30

Select Case c

Case 10
Range("c" & c1) = Range("a" & x + 1) 'columns c
c1 = c1 + 1

Case 20
Range("d" & d1) = Range("a" & x + 1) 'columns d
d1 = d1 + 1
Case 30
Range("e" & e1) = Range("a" & x + 1) 'columns e
e1 = e1 + 1
End Select

Next x
End Sub