几个格式相同的工作簿可以整合到一个工作簿中的多个sheet中吗

ymcly2009

各位好，有时从软件中会导出多个格式相同的工作簿，每个工作簿中只有一个工作表，如何将其放进一个工作簿中，且生成的这个工作簿中的每个sheet名为被导入的多个工作簿的名称（或其他名字也可以），用power query或pivot可以实现吗，或用其他方式可以实现吗？谢谢

3190496160

vba代码可以轻松实现，但是得上传你的附件来看看

3190496160

Sub 合并多薄一表为一薄多表()
Application.ScreenUpdating = False
Dim ww As Workbook
Dim sh As Worksheet
Dim arr(), brr()
Dim wb As Workbook
Dim dlgOpen As FileDialog
Set ww = ThisWorkbook
lj = ThisWorkbook.Path
VBA.ChDir lj
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
With dlgOpen
    If .Show <> -1 Then MsgBox "您没有选择文件夹！": Exit Sub
    lj = .SelectedItems(1)
End With
Application.DisplayAlerts = False
For Each sh In ww.Worksheets
    If sh.Index > 1 Then sh.Delete
Next sh
Application.DisplayAlerts = True
t = Timer
f = Dir(lj & "\*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(lj & "\" & f, 0)
        wb.Worksheets(1).Copy after:=ww.Worksheets(ww.Worksheets.Count)
        mc = Split(wb.Name, ".")(0)
        With ww.Worksheets(ww.Worksheets.Count)
            .Name = mc
        End With
       wb.Close False
    End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "合并完毕！耗时：" & Format(Timer - t, "0.00") & "秒", 64, "EXCEL提醒"

3190496160

合并工具.rar (17.11 KB, 下载次数: 6)

2022-8-22 10:21 上传

点击文件名下载附件

ymcly2009

3190496160 发表于 2022-8-22 10:21

大家都那么厉害，我试了，非常牛，速度也很快！感觉甚至连设置的打印格式都没有变化一起带过来了。再请教一下，如果这些工作簿中有多个工作表，且格式均一样，这些工作表的名字也一样，比如每个工作簿中均有三个工作表，工作表名称分别为2020年、2021年、2022年。我试的结果是将2020年的数据导入了，因为它排在第一个sheet，另两个工作表没有导进来，有办法解决吗？如果可以，结果会是怎么的，感谢

hbzql

用power query可以实现，还可以随时刷新，随时汇总

ymcly2009

hbzql 发表于 2022-8-23 00:39
用power query可以实现，还可以随时刷新，随时汇总

您好，可以说一下步骤吗，谢谢

ymcly2009

3190496160 发表于 2022-8-22 10:20
Sub 合并多薄一表为一薄多表()
Application.ScreenUpdating = False
Dim ww As Workbook

这应该是VB吧，感觉好难啊，象是编程，谢谢

ymcly2009

3190496160 发表于 2022-8-22 10:21

您好，非常感谢您的回复，在实务中非常有用，您方便在这个文件中再设置一个根据各个sheet的名字建立相应的索引的按钮吗，非常感谢！

3190496160

ymcly2009 发表于 2022-8-22 23:06
大家都那么厉害，我试了，非常牛，速度也很快！感觉甚至连设置的打印格式都没有变化一起带过来了。再请教 ...

说实话，不是很明白你的意思
你是需要工作表名称一致的数据合并在一个工作表中吗？
实在不行，可以加v具体沟通