如何将一张表中的数据按条件复制到另一张中

xioashu_1

朋友们：
    我有三级全部学生的成绩分另是表中的全1、全2、全3，现在怎么把全级学生的成绩按班级编号复制到各班成绩表中，对应关系是全1对应11、12、13……；全2对应21、22、23…… ； 全3对应31、32、33……

xioashu_1

这是学生成绩

iwangyi

Sub CC()
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Name <> "全1" And sh.Name <> "全2" And sh.Name <> "全3" Then sh.Delete
Next
Set cn = CreateObject("adodb.connection")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
For Each qj In Array("全1", "全2", "全3")
Sql = "SELECT distinct 班号 from [" & qj & "$A8:n]"
Set rs = cn.Execute(Sql)
Do Until rs.EOF
With Sheets.Add(AFTER:=Sheets(Sheets.Count))
x = rs.fields(0)
.Name = Mid(qj, 2, 1) & Mid(rs.fields(0), 2, 1)
sqll = "SELECT distinct * from [" & qj & "$A8:n] where 班号='" & rs.fields(0) & "'"
Rows(6).Resize(3).Copy .Cells(1, 1)
n = .[a65536].End(3).Row
.Range("a" & n + 1).CopyFromRecordset cn.Execute(sqll)
End With
rs.movenext
Loop
Next
End Sub

iwangyi

附件，请参考