Sub 分列行转表() '将按照某列分类保存到各工作表中,前提新建以某列数据命名的工作表 '原理:源数据每一列进行归类 Dim i As Long, pq As String, rng As Range i = 2 pq = Worksheets("浙南战区").Cells(i, "a").Value 'pq确定为某列的数据;红字部分根据实际情况命名 Do While pq <> "" Set rng = Worksheets(pq).Range("a1048576").End(xlUp).Offset(1, 0) Worksheets("浙南战区").Cells(i, "a").Resize(1, 7).Copy rng '将成绩复制到相应工作表中 ? i = i + 1 pq = Worksheets("浙南战区").Cells(i, "a").Value Loop End Sub