多工作簿汇总

ykcbf1100

多工作簿合并

1. Sub ykcbf()  '//2024.6.26  多工作簿汇总
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("汇总表")
   
5.     sh.UsedRange.Clear
   
6.     p = ThisWorkbook.Path & ""
   
7.     For Each f In fso.GetFolder(p).Files
   
8.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
9.             fn = fso.GetBaseName(f)
   
10.             m = m + 1
    
11.             Set wb = Workbooks.Open(f, 0)
    
12.             With wb.Sheets("Sheet1")
    
13.                 r = IIf(m = 1, 1, sh.Cells(Rows.Count, 2).End(3).Offset(1).Row)
    
14.                 r1 = .Cells(Rows.Count, 2).End(3).Row
    
15.                 .UsedRange.Offset(IIf(m = 1, 0, 2)).Copy sh.Cells(r, 1)
    
16.             End With
    
17.             wb.Close 0
    
18.         End If
    
19.     Next f
    
20.     With sh
    
21.         r = .Cells(Rows.Count, 2).End(3).Row
    
22.         .UsedRange.Offset(r).Clear
    
23.     End With
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "OK！"
    
26. End Sub
    

复制代码

ykcbf1100

kaili1223 发表于 2024-6-26 12:07
是改成[a3: aa5]吗

你的表述有问题啊，不能说是复制[a3:aa5]，而应该说，B列非空数据行