怎么合并同一文件夹下不同工作薄里面工作表名相同的文件

superdadong

比如我现在一个文件夹里有几份财务报表，分别是（上海店财务报表、天津店财务报表、无锡店财务报表、南通店财务报表...），每个工作薄里面都包含：资产负债表、利润表、现金流量表等，我想提取每家店的利润表到一个工作薄里面并排摆放，不是合并在一张表里

请问大神们，我该怎么做？谢谢！！！

huang1314wei

附件都没有，说啥都没用

superdadong

huang1314wei 发表于 2015-7-7 13:24
附件都没有，说啥都没用

附件加上，里面四张表，有一张是需要达到的效果

huang1314wei

1. Sub 按钮1_Click()
   
2.     Dim str$, myname$, ws As Worksheet
   
3.     Dim wb As Object
   
4.     Application.ScreenUpdating = False
   
5.     str = ThisWorkbook.Path & "" & "*.xls"
   
6.     myname = Dir(str)
   
7.     Do While myname <> ""
   
8.       If myname <> ThisWorkbook.Name Then
   
9.          Set wb = GetObject(ThisWorkbook.Path & "" & myname)
   
10.          For Each ws In wb.Worksheets
    
11.            If ws.Name = "利润表" Then
    
12.               ws.Copy after:=ThisWorkbook.Worksheets(Sheets.Count)
    
13.               ActiveSheet.Name = Left(wb.Name, 3) & ws.Name
    
14.            End If
    
15.          Next
    
16.          wb.Close False
    
17.        End If
    
18.        myname = Dir
    
19.      Loop
    
20.      Application.ScreenUpdating = True
    
21. End Sub

复制代码

huang1314wei

附件如下

新建文件夹.rar (70.8 KB, 下载次数: 287)

2015-7-7 15:14 上传

点击文件名下载附件

jjmysjg

huang1314wei 发表于 2015-7-7 15:14
附件如下

替楼主谢谢大师！
能加点功能--吧结果工作簿中的三张表汇总起来吗

huang1314wei

jjmysjg 发表于 2015-7-7 20:22
替楼主谢谢大师！
能加点功能--吧结果工作簿中的三张表汇总起来吗

道理是相同的，无非就是加几句代码

superdadong

huang1314wei 发表于 2015-7-7 15:14
附件如下

谢谢大神已完美得解决了我的问题，不胜感激！！！我这边还有个问题想请教一下，我现在附件里有三个表，我想提取每个表“合肥”那一列数据排列在一个新表里面，表头换成“4-6月合肥神秘客得分”，请问大神该怎么做？

huang1314wei

superdadong 发表于 2015-7-8 10:55
谢谢大神已完美得解决了我的问题，不胜感激！！！我这边还有个问题想请教一下，我现在附件里有三个表，我 ...

1. Sub text()
   
2.     Dim str$, myname$, serchname$
   
3.     Dim rng As Range
   
4.     Cells.Clear
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     str = ThisWorkbook.Path & "" & "*.xls"
   
8.     myname = Dir(str)
   
9.     serchname = InputBox("请输入你要合并的城市，比如：合肥，上海等", "系统提醒", "合肥")
   
10.     Do While myname <> ""
    
11.       If myname <> ThisWorkbook.Name Then
    
12.          Workbooks.Open (ThisWorkbook.Path & "" & myname)
    
13.          Set rng = ActiveWorkbook.Sheets(1).Rows(2).Find(serchname, lookat:=xlWhole)
    
14.          If rng Is Nothing Then
    
15.             MsgBox "未找到你选择的城市，汇总失败！"
    
16.             Exit Sub
    
17.          End If
    
18.          If Not rng Is Nothing Then
    
19.             rng.EntireColumn.Copy
    
20.             ThisWorkbook.Activate
    
21.             Sheets(1).Range("A1").Select
    
22.             Selection.Insert Shift:=xlToRight
    
23.          End If
    
24.          Workbooks(myname).Close False
    
25.       End If
    
26.       myname = Dir
    
27.      Loop
    
28.      Range("A1:C1").Merge
    
29.      [A1] = "4-6月" & serchname & "神秘客得分"
    
30.      Application.ScreenUpdating = True
    
31.      Application.DisplayAlerts = True
    
32. End Sub
    

复制代码

huang1314wei

superdadong 发表于 2015-7-8 10:55
谢谢大神已完美得解决了我的问题，不胜感激！！！我这边还有个问题想请教一下，我现在附件里有三个表，我 ...

附件如下：

神秘客分数修改.rar (287.21 KB, 下载次数: 165)

2015-7-8 12:47 上传

点击文件名下载附件