excel 查找&剪贴的宏

有一个表，只有一行
是一组题目的表
型如
1、题干
A
B
C
D
答案*
学科*
2、题目~~~~
~~~
~~
各个题目的学科不一样 能不能将不同学科的题目分类到sheet2的各列上
关于宏的思路我是这样想的
从第一行开始查找
遇到"学科1"就将上面的所有行剪切复制到sheet2的第一列
然后继续查找
遇到"学科2"就将上面的所有行剪切复制到sheet2的第二列
再继续查找
直到第n行结束

b2增加一个辅助列

=OFFSET(A2,SMALL(IF(LEFT(A2:A20,2)="学科",ROW($2:$20)-2,4^8),1),)

SHEET2的第一行输入各种学科
SHEET2的A2输入
=INDEX(Sheet1!$A1:$A4728,SMALL(IF(Sheet1!$B$1:$B$4728=A$1,ROW($1:$4728),4^8),ROW(A1)),)
公式往下往右拉即可， 都是数组公式~~

你可以描述一下期望的结果么？也就是sheet2的样子。

Sub m1()

Dim one_subject As String
Dim i As Integer
Dim j As Integer

j = Cells.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To j
Worksheets("Sheet1").Activate

Dim tempstr As String
Dim tempstr2 As String
Dim tempstr3 As String
tempstr = Cells(i, 1)
tempstr2 = Mid(tempstr, 1, 2)
tempstr3 = Mid(tempstr, 3)
If (tempstr2 <> "学科") Then
one_subject = one_subject & Cells(i, 1) & vbCrLf
Else
'将该题目插入到sheet2的相应地方
Dim y As Integer
y = CInt(tempstr3)
Dim tempstr4 As String