同一文件夹里的多个EXCEL表格合并到一个EXCEL表格里面

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim myPath$, myName$, wb As Workbook, rng As Range
   
3.     Dim funm$, n&, m&, nm$, Myc%
   
4.     Application.ScreenUpdating = False
   
5.     Set wb = ThisWorkbook
   
6.     funm = ThisWorkbook.Name
   
7.     Sheet1.Activate
   
8.     Cells.Clear
   
9.     myPath = ThisWorkbook.Path & ""
   
10.     myName = Dir(myPath & "*.xlsx")
    
11.     Do While myName <> "" And myName <> funm
    
12.         With GetObject(myPath & myName)
    
13.             n = n + 1
    
14.             nm = Split(myName, ".")(0)
    
15.             If n = 1 Then
    
16.                 .Sheets("初稿").[a1].CurrentRegion.Copy Cells(n, 2): [a1] = "区域"
    
17.                 m = Cells(Rows.Count, 2).End(xlUp).Row
    
18.                 Myc = [iv1].End(xlToLeft).Column
    
19.                 [a2].Resize(m - 1, 1) = nm
    
20.                 Rows(m).EntireRow.Delete
    
21.             Else
    
22.                 Set rng = .Sheets("初稿").[a1].CurrentRegion
    
23.                 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 2, Myc - 1)
    
24.                 m = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
25.                 rng.Copy Cells(m, 2)
    
26.                 Cells(m, 1).Resize(rng.Rows.Count, 1) = nm
    
27.             End If
    
28.             .Close False
    
29.         End With
    
30.         myName = Dir
    
31.     Loop
    
32.     m = Cells(Rows.Count, 2).End(xlUp).Row
    
33.     [a2].Resize(m - 1, 1).Borders.LineStyle = 1
    
34.     Application.ScreenUpdating = True
    
35. End Sub
    

复制代码

蓝桥玄霜

请见附件。

r342327115

蓝桥玄霜 发表于 2015-7-26 07:23
建议上传表格附件来说明问题。

工作中会有很多这种情况， 有时候会有20+个表在同一个文件夹里，就想把所有的表合并到一个excel里，方便下一步再操作，
请大大帮忙 ， 谢谢！


合并到一个excel里.rar (1.92 MB, 下载次数: 140)

2015-9-11 20:50 上传

点击文件名下载附件

蓝桥玄霜

r342327115 发表于 2015-9-11 20:51
工作中会有很多这种情况， 有时候会有20+个表在同一个文件夹里，就想把所有的表合并到一个excel里，方 ...

汇总成什么样子？建议做个效果表看看。

r342327115

蓝桥玄霜 发表于 2015-9-12 08:58
汇总成什么样子？建议做个效果表看看。

大大，请看附件效果

r342327115

蓝桥玄霜 发表于 2015-9-12 08:58
汇总成什么样子？建议做个效果表看看。

附件

合并到一个excel里.rar (1.68 MB, 下载次数: 120)

2015-9-13 09:26 上传

点击文件名下载附件

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim myPath$, myName$, Arr1 As Range, Myr&
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Sheet1.Activate
   
6.     Cells.Clear
   
7.     Call sc
   
8.     myPath = ThisWorkbook.Path & ""
   
9.     myName = Dir(myPath & "*.xlsx")
   
10.     Do While myName <> ""
    
11.         If InStr(myName, "合并") = 0 Then
    
12.         With GetObject(myPath & myName)
    
13.             Set Arr1 = .Sheets(1).Range("A3").CurrentRegion
    
14.             Myr = [i65536].End(xlUp).Row + 1
    
15.             If Myr < 4 Then Myr = 1
    
16.             Arr1.Copy Cells(Myr, 1)
    
17.             .Close False
    
18.         End With
    
19.         End If
    
20.         myName = Dir
    
21.     Loop
    
22.     Application.DisplayAlerts = True
    
23.     Application.ScreenUpdating = True
    
24. End Sub
    

复制代码

蓝桥玄霜

请见附件。

459309099

蓝桥玄霜 发表于 2012-11-12 12:11

请教大大，如何将一个文件夹下的多个EXCEL文件（每个文件了多个工作簿），汇总到一个EXCEL文件里。注：每个文件里的工作簿都是三个，标题都是一样的，只是下边填写的数据更换了。想要实现最后汇总表的那种，该如何操作！[url=]请教高手.zip[/url]

jscjch

路过，学习！谢谢蓝桥玄霜！