返回博客
5 分钟阅读

合并Excel文件

具体方法的执行还需要去看教程，这里就不说了。我只是记录一下不同的代码方面我自己查看使用。

教程基础教程Office English

具体方法的执行还需要去看教程，这里就不说了。我只是记录一下不同的代码方面我自己查看使用。

=VLOOKUP($B2,Sheet1!$B$2:$H$400,COLUMN(F1),0)&""

1. 合并多个文件到一个 sheet 里

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 & "\" & "*.xlsx")
    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

2. 合并多个文件到多个 sheets 里

注：此代码的应用条件是所有文件需要在同一个文件夹内。该代码会获取文件的命名，自动填充到对应的sheet里。由于Excel的sheet命名不支持大于31个字符，所以事先需要检查文件名长度是否复合要求。

Sub 合并多个文件到多个工作表()
    Dim Wk As Workbook, Sht As Worksheet, n As Integer, MyPath, MyName
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    n = 1
    MyPath = ThisWorkbook.Path & "\"  
    MyName = Dir(MyPath & "\" & "*.xlsx") 
    Do While MyName <> ""   
    If MyName <> ThisWorkbook.Name Then
        Set Wk = Workbooks.Open(MyPath & "\" & MyName)
        Wk.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Mid(MyName, 1, Len(MyName) - 4)
        'For Each Sht In Wk.Sheets
        'Sht.Name = Format(n, "000″)
        'n = n + 1
        'Next
        Wk.Close False
    End If
    MyName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "合并完毕！", vbInformation, "提示"
End Sub

3. 合并同一个文件里的多个 sheets

Sub UnionSheets()
    Application.ScreenUpdating = False
    For i = 1 To Sheets.Count
       If Sheets(i).Name <> ActiveSheet.Name Then
           X = Range("A65536").End(xlUp).Row + 1   '获取当前sheet中已有的行数，从+1行开始
           Sheets(i).UsedRange.Copy Cells(X, 1)    '往当前sheet中的Cells(X, 1)开始复制数据
       End If
    Next
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "合并完毕！", vbInformation, "报告"
End Sub

原教程在 这里 。

评论