多工作簿报表汇总

4684890

清风竹- 发表于 2013-3-27 21:03
把"利润分析表"变成"(利润分析表)"或加其他符号,在前面加,不删除试试.

原因是利润分析表（月度）的数值还衔接了其他工作表的数值，导致了列变动。
fs.Sheets("利润分析表（月度）").Range("C9:C40").Offset(0, (Split([a3], "月")(0)) - 1).Copy Destination:=Cells(9, i2).Resize(35, 1)
这句话能否改成粘贴数值过来

4684890

清风竹- 发表于 2013-3-27 21:03
把"利润分析表"变成"(利润分析表)"或加其他符号,在前面加,不删除试试.

解决了，呼呼，麻烦您类，呼呼

4684890

清风竹- 发表于 2013-3-27 21:03
把"利润分析表"变成"(利润分析表)"或加其他符号,在前面加,不删除试试.

1. Sub 汇总()
   
2. Dim wj As String, fs As Object, sl As Integer
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. wj = Dir(ThisWorkbook.Path & "\*.xlsx")
   
6. sl = Worksheets.Count
   
7. Do While wj <> ""
   
8. If wj <> ThisWorkbook.Name Then
   
9. Set fs = GetObject(ThisWorkbook.Path & "" & wj)
   
10. For i = 1 To sl
    
11. If ActiveSheet.Index < i Then
    
12. Worksheets(ActiveSheet.Index + 1).Activate
    
13. Else
    
14. Worksheets(1).Activate
    
15. End If
    
16. Exit For
    
17. Next
    
18.   fs.Sheets("资产负债表").Range("D8:D82").Offset(0, (Split([B2], "月")(0)) - 1).Copy
    
19.   Cells(4, 2).PasteSpecial xlPasteValues
    
20.   fs.Sheets("利润分析表（月度）").Range("U9:U40").Offset(0, (Split([B2], "月")(0)) - 1).Copy
    
21.   Cells(85, 2).PasteSpecial xlPasteValues
    
22.   fs.Sheets("现金流量表").Range("B8:B97").Offset(0, (Split([B2], "月")(0)) - 1).Copy
    
23.   Cells(122, 2).PasteSpecial xlPasteValues
    
24. fs.Close
    
25. End If
    
26. wj = Dir
    
27. Loop
    
28. Application.DisplayAlerts = True
    
29. Application.ScreenUpdating = True
    
30. End Sub

复制代码

大概意思是本工作簿有一分店，二分店，三分店...等50个表，然后选取和工作表名一样的工作簿打开，然后把3部分数值粘过来，数值区域无问题。
就想问一下如果一个按键设置，一个工作表取完数，自动到下一工作表，直到结束。（无法查到的保持原状态）
但是会提示下标越界，并且后边的表数据也没过来，是不是数值放在循环外了？应该怎么修改...
不是之前那个工作表了，是另一种汇总方式，哎

清风竹-

4684890 发表于 2013-3-28 18:15
大概意思是本工作簿有一分店，二分店，三分店...等50个表，然后选取和工作表名一样的工作簿打开，然后把3 ...

上传附件看看吧。

4684890

清风竹- 发表于 2013-3-28 19:47
上传附件看看吧。

您看一下...

清风竹-

1. 
   

复制代码

Sub 汇总()
Dim wj As String, fs As Object, sht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wj = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While wj <> ""
If wj <> ThisWorkbook.Name Then
   Set fs = GetObject(ThisWorkbook.Path & "\" & wj)
        For Each sht In Sheets
            If sht.Name = Split(wj, ".xlsx")(0) Then
                 fs.Sheets("资产负债表").Range("D8:D82").Offset(0, (Split([B2], "月")(0)) - 1).Copy
                 sht.Cells(4, 2).PasteSpecial xlPasteValues
                 fs.Sheets("利润分析表（月度）").Range("U9:U40").Offset(0, (Split([B2], "月")(0)) - 1).Copy
                 sht.Cells(85, 2).PasteSpecial xlPasteValues
                 fs.Sheets("现金流量表").Range("B8:B97").Offset(0, (Split([B2], "月")(0)) - 1).Copy
                 sht.Cells(122, 2).PasteSpecial xlPasteValues
             End If
        Next
    fs.Close
End If
wj = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub




没有测试，请楼主自己测试一下。

4684890

清风竹- 发表于 2013-3-28 20:42
Sub 汇总()
Dim wj As String, fs As Object, sht As Worksheet
Application.ScreenUpdatin ...

谢谢，加完班没带..明早看下..万分感谢

释释然

标注下{:soso_e113:}
改天来好好学习下

清风竹-

4684890 发表于 2013-3-28 21:55
谢谢，加完班没带..明早看下..万分感谢

fs.Sheets("资产负债表").Range("D8:D82").Offset(0, (Split([B2], "月")(0)) - 1).Copy
                 sht.Cells(4, 2).PasteSpecial xlPasteValues
                 fs.Sheets("利润分析表（月度）").Range("U9:U40").Offset(0, (Split([B2], "月")(0)) - 1).Copy
                 sht.Cells(85, 2).PasteSpecial xlPasteValues
                 fs.Sheets("现金流量表").Range("B8:B97").Offset(0, (Split([B2], "月")(0)) - 1).Copy
                 sht.Cells(122, 2).PasteSpecial xlPasteValues
将以上，改成以下试试。
               sht.Cells(4, 2).resize(75,1)= fs.Sheets("资产负债表").Range("D8:D82").Offset(0, (Split([B2], "月")(0)) - 1).value               
               sht.Cells(85, 2).resize(32,1) = fs.Sheets("利润分析表（月度）").Range("U9:U40").Offset(0, (Split([B2], "月")(0)) - 1) .value               
               sht.Cells(122, 2).resize(90,1) = fs.Sheets("现金流量表").Range("B8:B97").Offset(0, (Split([B2], "月")(0)) - 1).value

4684890

清风竹- 发表于 2013-3-29 06:30
fs.Sheets("资产负债表").Range("D8:D82").Offset(0, (Split(, "月")(0)) - 1).Copy
                  ...

上边的就能用，很好，感谢- -#