怎么把1 2 3 4 5表中的资产负债表利润表用循环复制到汇总表对应的表中

1565785678

老师们，怎么把1 2 3 4 5表中的资产负债表利润表用循环复制到汇总表对应的表中。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.30
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set ws = ThisWorkbook
   
6.     Set sh = ws.Sheets("操作台")
   
7.     Dim tm: tm = Timer
   
8.     For Each sht In ws.Sheets
   
9.         If sht.Name <> sh.Name Then sht.Delete
   
10.     Next
    
11.     p = ThisWorkbook.Path & ""
    
12.     For Each f In fso.GetFolder(p).Files
    
13.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
14.             m = m + 1
    
15.             Set wb = Workbooks.Open(f, 0)
    
16.             For Each sht In wb.Sheets
    
17.                 fn = m & sht.Name
    
18.                 sht.Copy After:=ws.Sheets(ws.Sheets.Count)
    
19.                 ws.Sheets(ws.Sheets.Count).Name = fn
    
20.             Next
    
21.             wb.Close False
    
22.         End If
    
23.     Next f
    
24.     sh.Activate
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
27. End Sub
    

复制代码

1565785678

ykcbf1100 发表于 2024-4-30 09:47
附件供参考。。。

老师，您太厉害了。就是要这样的结果

limonet

关键字：do while loop

limonet

Sub limonet()
    Dim Path$, FileName$, Sht As Worksheet
    Application.ScreenUpdating = False
    Path = ThisWorkbook.Path & "\"
    FileName = Dir(Path & "*.xls")
    Do While FileName <> ""
        If FileName <> "汇总表.xlsm" Then
            Workbooks.Open Path & FileName
            For Each Sht In Worksheets
                Sht.Name = Split(FileName, ".xls")(0) & Sht.Name
                Sht.Move After:=Workbooks("汇总表").Sheets(Workbooks("汇总表").Sheets.Count)
            Next Sht
        End If
        FileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

jjmysjg

多簿多表合并一簿多表

ykcbf1100

1565785678 发表于 2024-4-30 09:58
老师，您太厉害了。就是要这样的结果

不局限于二个表，可以把工作簿中所有表都复制过去。稍改一下，也可以把指定的若干表复制过去。