如何合并多个excel中(excel表格样式都一样)

版权声明:本文为博主原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/weixin_43144634/article/details/82689732

合并excel分为两种情况:1、将多个excel文件合并在一个excel中的不同sheet中。2、将多个excel文件合并在一个excel文件的一个sheet中。

 1、将多个excel的文件合并在一个excel文件的不同sheet中。

(1)首先,我们在Epan下的vb文件夹中创建4个excel文件,明明如下。

(2)打开命名为allExcel文件,按alt+F11调出vb编辑接口

(3)点击ThisWorkBook,并粘贴如下代码:

Private Sub hb()
    Dim hb As Object, kOne As Boolean, tabcolor As Long
    Set hb = Workbooks.Add
    Application.DisplayAlerts = False
    For i = hb.Sheets.Count To 2 Step -1
        hb.Sheets(i).Delete
    Next
     
    Dim FileName As String, FilePath As String
    Dim iFolder As Object, rwk As Object, Sh As Object
    Set iFolder = CreateObject("shell.application").BrowseForFolder(0, "请选择要合并的文件夹", 0, "")
    If iFolder Is Nothing Then Exit Sub
    FilePath = iFolder.Items.Item.Path
    FilePath = IIf(Right(FilePath, 1) = "\", FilePath, FilePath & "\")
    FileName = Dir(FilePath & "*.xls*")
    Do Until Len(FileName) = 0
        If UCase(FilePath & FileName) <> UCase(ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then
            Set rwk = Workbooks.Open(FileName:=FilePath & FileName)
            tabcolor = Int(Rnd * 56) + 1
            With rwk
                For Each Sh In .Worksheets
                    Sh.Copy After:=hb.Sheets(hb.Sheets.Count)
                    hb.Sheets(hb.Sheets.Count).Name = FileName & "-" & Sh.Name
                    hb.Sheets(hb.Sheets.Count).Tab.ColorIndex = tabcolor
                    If Not kOne Then hb.Sheets(1).Delete: kOne = True
                Next
                .Close True
             End With
        End If
        Set rwk = Nothing
        FileName = Dir
    Loop
    Application.DisplayAlerts = True
End Sub

(3)按F5运行,会弹出让你选择要合并的文件夹的窗口

(4)代码执行结果如下:

2、将多个excel文件合并在一个excel文件的一个sheet中。

(1)打开allExcel调出VB编程接口,粘贴如下代码

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("a65536").end(xlup).row + 2, 1) = left(myname, len(myname) - 4) 
for g = 1 to sheets.count 
wb.sheets(g).usedrange.copy .cells(.range("a65536").end(xlup).row + 1, 1) 
next 
wbn = wbn & chr(13) & wb.name 
wb.close false 
end with 
end if 
myname = dir 
loop 
range("a1").select 
application.screenupdating = true 
msgbox "共合并了" & num & "个工作薄下的全部工作表。如下:" & chr(13) & wbn, vbinformation, "提示" 
end sub

(2)按F5运行代码,选择要合并的文件,效果如下

展开阅读全文

没有更多推荐了,返回首页