求大神帮忙：如何能将多个不同表格的内容，自动填充到另一个总表中。

benny888

我的问题是：目前同一个文件夹里，有N个文档（文档数可能有几十个或上百个，文件名，以客户电话号码命名），如附件“11111111”，“22222222”，“总表”，这3个表，我设想是：能否在总表中，将文件夹里的N个文档（以文件名）里的内容，按顺序自动填写到总表里面？如果不能，退一步，能否我在“总表”中，录入“客户电话栏”，后面的数据自动填充？

如果还是不能，请大神指教一下，有什么好的方法，谢谢


请各位大神、各位老师，看能不能操作…………万分感谢。

benny888

请问有大神能帮忙吗。。。。。

小花鹿

搜索汇总工作薄，有很多.........................................................................................

benny888

小花鹿 发表于 2017-3-14 11:04
搜索汇总工作薄，有很多.............................................................................. ...

你好，大虾，我知道是比较难，
如果说，文件名，都是以某一数字开始，如26654134，23654695......，以2字开头的，8位数字命名呢？能完成吗？

小花鹿

benny888 发表于 2017-3-15 08:53
你好，大虾，我知道是比较难，
如果说，文件名，都是以某一数字开始，如26654134，23654695......，以2 ...

与文件名没有关系，任何文件名都可以做到......................................................................

benny888

小花鹿 发表于 2017-3-15 09:01
与文件名没有关系，任何文件名都可以做到............................................................ ...

大神，请指示

benny888

小花鹿 发表于 2017-3-15 09:01
与文件名没有关系，任何文件名都可以做到............................................................ ...

因为刚刚接触VB，什么也不太懂，希望老师能指点一下，谢谢

hzruziniu

benny888 发表于 2017-3-15 16:50
因为刚刚接触VB，什么也不太懂，希望老师能指点一下，谢谢

电话号码命名的工作簿中，是一个工作表还是所有工作表都有信息，现的工作簿比喻：11111111中只有一个Sheet1有信息，而Sheet2和Sheet3没有信息。

xiangbaoan

详见附件中总表，可试一下行否。

hzruziniu

1. Sub 汇总本夹内多簿多表数据() '
   
2.     Dim Mypath$, Myname$
   
3.     Dim sh As Worksheet, rng As Range
   
4.     Dim arr, brr(), i&, j%, n&, r&
   
5.     Mypath = ThisWorkbook.Path & ""    '本文件夹名
   
6.     Myname = Dir(Mypath & "*.xlsx")     '本文件夹下的工作簿
   
7.     Application.ScreenUpdating = False
   
8.     ReDim brr(1 To 5000, 1 To 12)       '定义动态数组大小
   
9.     Do While Myname <> ""               '遍历工作簿查找
   
10.         If Myname <> ThisWorkbook.Name Then   '如果工作簿不是本工作簿
    
11.             With GetObject(Mypath & Myname)   '后台打开该工作簿
    
12.                 For Each sh In .Sheets        '打开的工作簿再遍历工作表查找
    
13.                     Set rng = sh.Cells(3, 1)  '工作表的A3单元格
    
14.                     If Not rng Is Nothing Then             '如果A3单元格不为空
    
15.                         r = sh.Cells(65536, 1).End(3).Row  '返回该工作表的最下标定义为r
    
16.                         arr = sh.Range("a3:l" & r).Value   '把数据区域赋值给数组arr
    
17.                         For i = 1 To UBound(arr)           'arr起始循环
    
18.                             If arr(i, 1) <> "" Then        '如果有值
    
19.                                 n = n + 1                  '逐行递增
    
20.                                 For j = 1 To 12            '第一列到12列循环
    
21.                                    brr(n, j) = arr(i, j)   '把arr数组区的值赋给数组brr
    
22.                                 Next
    
23.                             End If
    
24.                         Next
    
25.                     End If
    
26.                 Next
    
27.                 .Close False
    
28.             End With
    
29.         End If
    
30.         Myname = Dir
    
31.     Loop
    
32.     With Sheets("汇总表")
    
33.         Range("a3:l" & Rows.Count).Clear           '先清除a3以下所有数据及格式
    
34.         Range("a3").Resize(n, 12) = brr            '再把brr数组赋值到A3开始以下区域
    
35.         Cells(n + 3, 1) = "合  计"
    
36.         For j = 3 To 12
    
37.             Cells(n + 3, j).Value = Application.WorksheetFunction.Sum(Range(Cells(3, j), Cells(n + 2, j)))
    
38.         Next
    
39.         With Range("a3").Resize(n + 1, 12)
    
40.            .Resize(n + 1, 12).Borders.LineStyle = 1                    '添加边框线
    
41.            .Font.Size = 10                                             '字体为10号
    
42.         End With
    
43.        [a1].Resize(n + 3, 12).BorderAround xlContinuous, xlMedium      '外边框加粗
    
44.        [a3].Resize(n + 1, 1).HorizontalAlignment = xlCenter ' xlLeft '向左对齐   xlCenter '居中对齐  xlRight '向右对齐
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47. End Sub
    

复制代码