怎么把100多个EXCEL文件合并成一个

haha02388453

老师们好，我在百度上搜到一个宏的代码拿去试，发现数据一多的时候，合并后对比少了很多。我又不知道哪里出错。我就想是不是把下面这个B65536改为100000 大点就可以，但是改完出问题。

.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & "\" & "*.xls")

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName <> ""

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & "\" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Next

WbN = WbN & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MyName = Dir

Loop

Range("B1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub

xlgw521

，这个65536是指EXCEL行数量，不是指你标题中的文件数量。批量合并EXCEL文件功能 可以在网上搜相关的插件如： 方方格子、    SOSO工具     等都有。

3190496160

上传附件才好测试代码的

刀羊

可能确实是你的数据太多了，
如果把代码存在一个.xlsm的文件里，再改65536为100000会不会好一点？

adai2014

试一下配pq

yakei

1. <p><p>Private Sub 复制工作表_Click()</p><p>Dim wb As Workbook, sh As Worksheet        '定义 wb 为工作薄，sh 为工作表
   
2. Application.ScreenUpdating = False              '使Excel停止刷新，这样可以提高代码的执行速度
   
3.     sPath = "D:\文件"                                   '打开指定文件夹
   
4.     sFile = Dir(sPath & "\*.xls*")                    '打开所有后缀为.xls*的文件
   
5.     Do While sFile <> ""                                '开始循环
   
6.         If sFile <> ThisWorkbook.Name Then Workbooks.Open (sPath & "" & sFile)
   
7.         sFile = Dir
   
8.         Loop                                                    '循环结束
   
9.         With ThisWorkbook.Sheets
   
10.             For Each wb In Workbooks                 '历遍所有工作簿
    
11.                 If wb.Name <> ThisWorkbook.Name Then              '排除本工作簿
    
12.                     For Each sh In wb.Sheets                                   '逐表
    
13.                         sh.Copy after:=.Item(.Count)                          '复制到本工作簿最右边
    
14.                     Next
    
15.                 End If
    
16.             Next
    
17.             .Item(1).Activate                                                        '激活本工作簿第一表
    
18.         End With
    
19.         For Each wb In Application.Workbooks                              '关闭本工作簿以外所有工作簿
    
20.             If wb.Name <> ThisWorkbook.Name Then wb.Saved = True: wb.Close False
    
21.         Next</p><p>Application.ScreenUpdating = True
    
22. End Sub</p></p>

复制代码

试试这个

熊文来

yakei 发表于 2021-5-1 16:26
试试这个

如果是多个工作簿，每个工作簿里有多张工作表，主要是合并其中某一个工作表，例如都是sheet1这个工作表，这个工作表的标头有多行，工作表里的数据不规律。能帮忙看看吗？

每个工作簿的最后一行合计和备注不同合并到总得工作簿里面。

谢谢您帮我看看。