VBV 多个工作薄合并一个工作表

小曹369

各老师，请帮忙看一下如何把多个工作薄不打开情况复制到一个指定的工作表。谢谢

taller

是否打开工作簿是个重要的前提条件吗？

3190496160

其实就是多薄一表合并为一薄一表功能，可以看看这个帖子，下载就能用
合并工具-Excel VBA程序开发-ExcelHome技术论坛 -  https://club.excelhome.net/threa ... tml?_dsign=4f56a4db

3190496160

Sub 合并()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
ReDim br(1 To 200000, 1 To 16)
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.xls*")
Set sh = ThisWorkbook.Sheets(1)
t = Timer
sh.[a1].CurrentRegion.Clear
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        m = m + 1
        Set wb = Workbooks.Open(lj & f, 0)
        With wb.Worksheets(1)
            r = .Cells(Rows.Count, 1).End(xlUp).Row
            If m = 1 Then
                .Range("a1:p" & r).Copy sh.[a1]
            Else
                rs = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Range("a2:p" & r).Copy sh.Cells(rs, 1)
            End If
        End With
        wb.Close False
    End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "耗时：" & Format(Timer - t, "0.00") & "秒！"
End Sub

3190496160

生产工单.rar (36.8 KB, 下载次数: 10)

2024-11-18 09:16 上传

点击文件名下载附件

zpy2

https://club.excelhome.net/forum.php?mod=viewthread&tid=1679471&page=1&mobile&_dsign=772c0d77

z865593849

不打开文件提取数据

usedrange

。。。。。。。。。。