汇总一个文件夹的所有工作簿，并在汇总第一个列填充工作簿名称

志65

Hi，我想要汇总一个文件夹的所有工作簿，汇总里面的内容若是有格式的也显示一样的格式，如百分比。汇总表里面每个工作簿内容都要相隔一行。如截图。多谢

liulang0808

http://club.excelhome.net/thread-1258425-1-1.html
资料供参考。。。

xiangbaoan

……………………

729211ying

Sub ss()
Filename = Application.GetOpenFilename
a = VBA.InStrRev(Filename, "\")
folder = Left(Filename, a)
Filename = Dir(folder)
k = 2
m = 1
Do While Filename <> ""
   Set wb = Workbooks.Open(folder & Filename)
   bb = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   wb.Worksheets(1).Range("a2:d" & bb).Copy Cells(k, 2)
   For i = k To k + bb - 1
       Cells(i, 1) = m
   Next
   m = m + 1
   k = k + bb
   wb.Close
   Filename = Dir
Loop
Cells(1, 1) = "文件"
Cells(1, 2) = "Sessions"
Cells(1, 3) = "Session Percentage"
Cells(1, 4) = "Page Views"
Cells(1, 5) = "Page Views Percentage"
End Sub

729211ying

ub ss()
Filename = Application.GetOpenFilename
a = VBA.InStrRev(Filename, "\")
folder = Left(Filename, a)
Filename = Dir(folder)
k = 2
m = 1
Do While Filename <> ""
   Set wb = Workbooks.Open(folder & Filename)
   bb = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   wb.Worksheets(1).Range("a2:d" & bb).Copy Cells(k, 2)
   For i = k To k + bb - 2
       Cells(i, 1) = m
   Next
   m = m + 1
   k = k + bb
   wb.Close
   Filename = Dir
Loop
Cells(1, 1) = "文件"
Cells(1, 2) = "Sessions"
Cells(1, 3) = "Session Percentage"
Cells(1, 4) = "Page Views"
Cells(1, 5) = "Page Views Percentage"
End Sub

729211ying

前提把附件解压到桌面，就OK了

729211ying

ub ss()
Filename = Application.GetOpenFilename
a = VBA.InStrRev(Filename, "\")
folder = Left(Filename, a)
Filename = Dir(folder)
k = 2
m = 1
Do While Filename <> ""
   Set wb = Workbooks.Open(folder & Filename)
   bb = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   wb.Worksheets(1).Range("a2:d" & bb).Copy Cells(k, 2)
   For i = k To k + bb - 2
       Cells(i, 1) = m
   Next
   m = m + 1
   k = k + bb
   wb.Close
   Filename = Dir
Loop
Cells(1, 1) = "文件"
Cells(1, 2) = "Sessions"
Cells(1, 3) = "Session Percentage"
Cells(1, 4) = "Page Views"
Cells(1, 5) = "Page Views Percentage"
End Sub

729211ying

附件里有新代码

志65

729211ying 发表于 2018-9-11 20:21
附件里有新代码

多谢,但是第一列无法获取到工作簿的名称.如截图.A列没有获取到对应工作簿的名称,只有数字.

志65

xiangbaoan 发表于 2018-9-11 18:49
……………………

不行耶.显示未指定错误,如截图