Sub bbb()
Application.ScreenUpdating = False
[a2:D65536].ClearContents
Set hz = ActiveSheet
h = 2
f = Dir(ThisWorkbook.Path & "\*.xls")
Do While f > " "
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
hz.Cells(h, 1) = Left(f, Len(f) - 4)
ar = wb.Sheets("sheet1").[a2:d2]
hz.Cells(h, 1).Resize(1, 4) = ar
h = h + 1
wb.Close
End If
f = Dir
Loop
Application.ScreenUpdating = True
End Sub
汇总表放同一文件夹中
Sub test()
Dim fs, f, f1, fc, s
s = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Documents\....\") '此处录入文件夹路径
Set fc = f.Files
For Each f1 In fc
Sheets(1).Cells(s, 1) = f1.Name
s = s + 1
Next
End Sub
给个导入考号的例子给你,不知道你XLS表中一个表有多个学生成绩还是如何.等待高人回答.