如何把同一文件夹下多个工作表合并，一表多sheet

qamiao

附件请参考。

小施看世界

我知道！

伤脑筋aiya

可以运行的哇，只不过这个只能合并 .xls的文件，不能合并.xlsx的

wyflyinglw

Sub 多工作簿合并到同一个工作表()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim f_name As String
Dim bok1 As Workbook, bok2 As Workbook
Set bok2 = Nothing
    f_name = Dir(ThisWorkbook.Path & "\*.*") '获得该目录下的所有EXCEL文件
    Do While f_name <> "" '开始执行循环
        If f_name <> ThisWorkbook.Name And (f_name Like "*.xlsx" Or f_name Like "*.xls") Then  '如果当前的文件不是代码所在文件，执行合并操作
            Set bok1 = Workbooks.Open(ThisWorkbook.Path & "\" & f_name) '打开被合并的文件
                bok1.Sheets(1).Copy After:=ThisWorkbook.Sheets(1) '如果合并后的文件存，在则将被合并文件的第一个工作表复制到合并文件中。
            bok1.Close '关闭被合并文件
        End If
        f_name = Dir() '获取下一个被合并文件名
    Loop

Dim XSheet As Worksheet
For i = ThisWorkbook.Sheets.Count To 2 Step -1
If Sheets(1).UsedRange.Rows.Count = 1 Then
If Sheets(i).UsedRange.Rows.Count > 1 Then
Sheets(i).Rows("1:" & Sheets(i).UsedRange.Rows.Count).Copy Sheets(1).Rows(Sheets(1).UsedRange.Rows.Count)
Sheets(i).Delete
End If
Else
If Sheets(i).UsedRange.Rows.Count > 1 Then
Sheets(i).Rows("1:" & Sheets(i).UsedRange.Rows.Count).Copy Sheets(1).Rows(Sheets(1).UsedRange.Rows.Count + 1)
Sheets(i).Delete
End If
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

wangyuhui7

如表名,直接运行就可