如何把一个工作簿中的多个表的内容汇总到另一个工作簿中

wuchunmingde

我第一个工作簿（学生基本信息）中有一个班31个学生的基本信息表，现在要把这31个学生的基本信息汇总在第二个工作簿（学生数据导入模板）中，具体表见附件，望高手详细解答。

lyf7276

你把你的模板那个表头写标准，信息表上是什么，你的模板上就一定要写成什么。

wp8680

1. Sub 导入()
   
2.     Dim Wb As Workbook    '定义Wb为工作簿对象型变量
   
3.     Dim MyPth As String    '定义MyPth为文本型变量
   
4.     Dim arr()
   
5.     Application.ScreenUpdating = False '关闭屏幕刷新
   
6.     MyPth = ThisWorkbook.Path & "\学生基本信息.xls"    '把数据源工作簿路径赋给MyPth
   
7.     Set Wb = GetObject(MyPth)    '把返回路径上的文件引用且赋值给Wb
   
8.     With Wb
   
9.         ReDim arr(1 To Wb.Sheets.Count, 1 To 76)
   
10.         For k = 1 To Wb.Sheets.Count
    
11.             With Wb.Sheets(k)
    
12.                 arr(k, 1) = .Range("d19") & .Range("d20")
    
13.                 arr(k, 2) = .Range("d5")
    
14.                 arr(k, 3) = .Range("d6")
    
15.                 arr(k, 4) = .Range("h5")
    
16.                 arr(k, 5) = .Range("h6")
    
17.                 arr(k, 6) = .Range("d10")
    
18.                 arr(k, 7) = .Range("d7")
    
19.                 arr(k, 8) = .Range("h17")
    
20.                 arr(k, 9) = .Range("h18")
    
21.                 arr(k, 10) = .Range("d18")
    
22.                 arr(k, 11) = .Range("d15")
    
23.                 arr(k, 12) = .Range("d9")
    
24.                 arr(k, 13) = .Range("h14")
    
25.                 arr(k, 14) = .Range("h19")
    
26.                 arr(k, 15) = .Range("h20")
    
27.                 arr(k, 16) = .Range("d14")
    
28.                 arr(k, 17) = .Range("d9")
    
29.                 arr(k, 18) = .Range("d8")
    
30.                 arr(k, 19) = .Range("d22")
    
31.                 arr(k, 20) = .Range("d23")
    
32.                 arr(k, 21) = .Range("h22")
    
33.                 arr(k, 22) = .Range("d25")
    
34.                 arr(k, 23) = .Range("h23")
    
35.                 arr(k, 24) = .Range("h24")
    
36.                 arr(k, 25) = .Range("h7")
    
37. 
    
38.             '以下代码请自行补充完整,这里不再一一罗列
    
39.                 arr(k, 26) = ""
    
40.                 arr(k, 27) = ""
    
41.                 arr(k, 28) = ""
    
42.                 arr(k, 29) = ""
    
43.                 arr(k, 30) = ""
    
44.                 arr(k, 31) = ""
    
45.                 arr(k, 32) = ""
    
46.                 arr(k, 33) = ""
    
47.                 arr(k, 34) = ""
    
48.                 arr(k, 35) = ""
    
49.                 arr(k, 36) = ""
    
50.                 arr(k, 37) = ""
    
51.                 arr(k, 38) = ""
    
52.                 arr(k, 39) = ""
    
53.                 arr(k, 40) = ""
    
54.                 arr(k, 41) = ""
    
55.                 arr(k, 42) = ""
    
56.                 arr(k, 43) = ""
    
57.                 arr(k, 44) = ""
    
58.                 arr(k, 45) = ""
    
59.                 arr(k, 46) = ""
    
60.                 arr(k, 47) = ""
    
61.                 arr(k, 48) = ""
    
62.                 arr(k, 49) = ""
    
63.                 arr(k, 50) = ""
    
64.                 arr(k, 51) = ""
    
65.                 arr(k, 52) = ""
    
66.                 arr(k, 53) = ""
    
67.                 arr(k, 54) = ""
    
68.                 arr(k, 55) = ""
    
69.                 arr(k, 56) = ""
    
70.                 arr(k, 57) = ""
    
71.                 arr(k, 58) = ""
    
72.                 arr(k, 59) = ""
    
73.                 arr(k, 60) = ""
    
74.                 arr(k, 61) = ""
    
75.                 arr(k, 62) = ""
    
76.                 arr(k, 63) = ""
    
77.                 arr(k, 64) = ""
    
78.                 arr(k, 65) = ""
    
79.                 arr(k, 66) = ""
    
80.                 arr(k, 67) = ""
    
81.                 arr(k, 68) = ""
    
82.                 arr(k, 69) = ""
    
83.                 arr(k, 70) = ""
    
84.                 arr(k, 71) = ""
    
85.                 arr(k, 72) = ""
    
86.                 arr(k, 73) = ""
    
87.                 arr(k, 74) = ""
    
88.                 arr(k, 75) = ""
    
89.                 arr(k, 76) = ""
    
90.             End With
    
91.         Next k
    
92.         Wb.Close False    '关才Wb工作簿，且不保存更改
    
93.     End With    '
    
94.     Set Wb = Nothing    '释放内存
    
95.     Range("a3").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
96.     Application.ScreenUpdating = True '打开屏幕刷新
    
97. 
    
98. End Sub

复制代码

wp8680

样表.rar (33.03 KB, 下载次数: 16)

2013-5-29 20:29 上传

点击文件名下载附件