多工作簿内的工作表合并

枫丹白露

chxw68 发表于 2025-3-13 20:07
参与一下。

谢谢，你的代码有带格式，很不错

枫丹白露

chxw68 发表于 2025-3-13 20:07
参与一下。

老师，这个代码要怎么改，我想只复制数据，不带格式                  
                            If r > 4 Then
                                .Range("5:" & r).Copy ThisWorkbook.Worksheets("总表").Cells(m, 1)
                                m = m + r - 4
                            End If

chxw68

修改好了。

枫丹白露

chxw68 发表于 2025-3-15 08:52
修改好了。

谢谢，太感谢了。代码很好用，已经用上了。
我也是想加PasteSpecial，就是不懂语法，学艺不精

shiruiqiang

gwjkkkkk 发表于 2025-3-13 18:39
Option Explicit
Sub test1()
    Dim ar, i&, j&, cnn As Object, rst As Object, strSQL$, strCnn$, st ...

老师，看见学习书籍，说是strSQL = strSQL & " UNION ALL”不能超过50个工作簿。
现在lz要求有100个如何处理？
我尝试了，一直报错。
最后还是学习baofa2老师的，每个工作簿的写入同一个excel表。

usedrange

放在总表的workbook中运行

usedrange

1. Sub hmc()
   
2.     Dim fso, fs, f, r%, rr%, pa$, wb, sh
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     pa = ThisWorkbook.Path
   
5.     Set fs = fso.getfolder(pa).Files
   
6.     Set sh = Workbooks("总表.xlsm").Sheets("总表")
   
7.     For Each f In fs
   
8.         If InStr(f, "班级") Then
   
9.             Set wb = GetObject(f)
   
10.             r = wb.Sheets(1).[b5].SpecialCells(xlCellTypeLastCell).Row
    
11.             rr = sh.[b10000].End(3).Row
    
12.             wb.Sheets(1).[b5].Resize(r, 12).Copy sh.Cells(rr + 1, "b")
    
13.             wb.Close
    
14.         End If
    
15.     Next f
    
16.     Set fso = Nothing
    
17.     Set fs = Nothing
    
18. End Sub
    

复制代码

gwjkkkkk

shiruiqiang 发表于 2025-3-19 13:20
老师，看见学习书籍，说是strSQL = strSQL & " UNION ALL”不能超过50个工作簿。
现在lz要求有100个如何 ...

对的，union方式只能50个连接，如果超过则分组以50个一组来实现，或baofa2大师方式也可，这样简单一些。