多工作簿内的工作表合并

gwjkkkkk

代码审核中。。。

枫丹白露

ykcbf1100 发表于 2025-3-13 18:00
附件供参考，原则上工作簿可以有很多

谢谢，试了可以。但文件夹里有其它表也会被提取进来，能不能只提取命名为“班级*”的工作表数据

ykcbf1100

枫丹白露 发表于 2025-3-13 19:25
谢谢，试了可以。但文件夹里有其它表也会被提取进来，能不能只提取命名为“班级*”的工作表数据

改好了，只提取文件名中含有班级字样的工作表数据

chxw68

1. Sub test2()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim wb As Workbook
   
5.     Dim ws As Worksheet
   
6.     Dim mypath$, myname$
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     With ThisWorkbook.Worksheets("总表")
   
10.         .Rows("5:" & .Rows.Count).ClearContents
    
11.     End With
    
12.     m = 5
    
13.     mypath = ThisWorkbook.Path & ""
    
14.     myname = Dir(mypath & "*.xlsm")
    
15.     Do While myname <> ""
    
16.         If myname <> ThisWorkbook.Name Then
    
17.             Set wb = GetObject(mypath & myname)
    
18.             With wb
    
19.                 For Each ws In .Worksheets
    
20.                     If ws.Name Like "班级*" Then
    
21.                         With ws
    
22.                             r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
23.                             If r > 4 Then
    
24.                                 .Range("a5:n" & r).Copy ThisWorkbook.Worksheets("总表").Cells(m, 1)
    
25.                                 m = m + r - 4
    
26.                             End If
    
27.                         End With
    
28.                     End If
    
29.                 Next
    
30.                 .Close False
    
31.             End With
    
32.         End If
    
33.         myname = Dir
    
34.     Loop
    
35.             
    
36.                            
    
37. End Sub
    

复制代码

chxw68

参与一下。

枫丹白露

ykcbf1100 发表于 2025-3-13 19:30
改好了，只提取文件名中含有班级字样的工作表数据

谢谢大神，能再帮加两条代码，因为老师会在表末记录一些备注，所以定义到A列最后一个空白行。还有添加数据到总表延用上行的格式，非常感谢

ykcbf1100

枫丹白露 发表于 2025-3-13 20:31
谢谢大神，能再帮加两条代码，因为老师会在表末记录一些备注，所以定义到A列最后一个空白行。还有添加数 ...

你看一下。

枫丹白露

ykcbf1100 发表于 2025-3-13 20:46
你看一下。

格式没有延用上一行，也没有取到班级A列的最后一行非空白数据，多了很多空行，还多了一个自动添序号。不要自动添加序号。

这个代码我有些理解不了，不然我想把序号清除的

ykcbf1100

枫丹白露 发表于 2025-3-13 21:13
格式没有延用上一行，也没有取到班级A列的最后一行非空白数据，多了很多空行，还多了一个自动添序号。不 ...

你把我搞糊涂了，关于多了空行，那不是你自己要求的吗（不然，原来的代码就已经达到要求了）？
关于格式，我是把第6行的格式复制到最后一行的，所以说，这一点是达到要求的。
好吧，我再改一次，不过，这是我最后一次修改了。

枫丹白露

ykcbf1100 发表于 2025-3-14 06:59
你把我搞糊涂了，关于多了空行，那不是你自己要求的吗（不然，原来的代码就已经达到要求了）？
关于格式 ...

谢谢，非常感谢