工作表结构相同的多工作薄能合并成一个工作薄文件吗

guihuawc

　我将学生基本信息设计成一个工作表下发给班上学生，让学生填写好各自的信息之后又回传给我，一下有了55个电子表格文件，每个文件里只有一个学生的信息，这个能不能一下就将所有学生的信息合并在一个工作薄里的一个工作表吗？　请教高手啦　先谢谢

guihuawc

补充　55个文件的名称是以学生姓名命名的 需要合并的工作薄.zip (37.8 KB, 下载次数: 27)

2017-3-3 09:02 上传

点击文件名下载附件

chxw68

guihuawc 发表于 2017-3-2 19:48
补充　55个文件的名称是以学生姓名命名的

完全可以。

guihuawc

老师 请告知方法 谢谢啊

guihuawc

chxw68 发表于 2017-3-2 19:51
完全可以。

拜托 老师帮帮忙

jiminyanyan

guihuawc 发表于 2017-3-2 20:29
老师 请告知方法 谢谢啊

要传个附件上来…………

guihuawc

jiminyanyan 发表于 2017-3-2 20:30
要传个附件上来…………

附件已上传请老师看一下　谢谢

guihuawc

chxw68 发表于 2017-3-2 19:51
完全可以。

已上传附件　请老师看看

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr(1 To 1000, 1 To 8)
   
4.   Dim wb As Workbook
   
5.   Dim ws As Worksheet
   
6.   Dim mypath$, myname$
   
7.   Application.ScreenUpdating = False
   
8.   Application.DisplayAlerts = False
   
9.   mypath = ThisWorkbook.Path & ""
   
10.   myname = Dir(mypath & "*.xls*")
    
11.   m = 0
    
12.   Do While myname <> ""
    
13.     If myname <> ThisWorkbook.Name Then
    
14.       m = m + 1
    
15.       Set wb = GetObject(mypath & myname)
    
16.       With wb
    
17.         With .Worksheets(1)
    
18.           r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
19.           arr = .Cells(r, 1).Resize(1, 8)
    
20.           For j = 1 To UBound(arr, 2)
    
21.             brr(m, j) = arr(1, j)
    
22.           Next
    
23.         End With
    
24.         .Close False
    
25.       End With
    
26.     End If
    
27.     myname = Dir()
    
28.   Loop
    
29.   With Worksheets("sheet1")
    
30.     .UsedRange.Offset(3, 0).ClearContents
    
31.     .Range("a4").Resize(UBound(brr), UBound(brr, 2)) = brr
    
32.   End With
    
33. End Sub
    

复制代码

chxw68

详见附件。