通过VBA将多个格式相同的Excel文件合并成一个文件，带文件处理

• 打开Excel文件，启用“开发人员工具”

• 启用宏和VBA功能

• 添加3个模块

代码如下：

Sub 工作薄间工作表合并()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
FileToOpen_N = Application.GetOpenFilename("xlsx文件,*.xlsx", Title:="请选择要合并工作簿:", MultiSelect:=True)
Newbz = 0
On Error Resume Next
For Each FileToOpen In FileToOpen_N
 If FileToOpen <> False Then
  If Newbz = 0 Then
   Booknum = Application.SheetsInNewWorkbook
   Application.SheetInNewWorkbook = 1
   Workbooks.Add
   Application.SheetsInNewWorkbook = Booknum
   NewBookName = ActiveWorkbook.Name
   Sheets(1).Name = "sheet_tmp"
   Newbz = 1
  End If
  Set OpenBook = Workbooks.Open(FileToOpen)
  For Each Xlsheet In OpenBook.Sheets
   Xlsheet.Copy Before:=Workbooks(NewBookName).Sheets("sheet_tmp")
  Next
  OpenBook.Close SaveChanges:=False
 End If
Next
Workbooks(NewBookName).Sheets("sheet_tmp").Delete
Application.ScreenUpadating = True
Application.DisplayAlerts = True
End Sub

Sub 多张表格中输入对应的订单号()
Application.ScreenUpdating = False
With ActiveSheet
    For i = 7 To 6000
        If .Cells(i, 2) <> "" Then
            .Cells(i, 20) = Range("F3").Value
        Else
            .Cells(i, 20) = ""
        End If
    Next
End With
For j = 1 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name Then
    For i = 7 To 6000
        If Cells(i, 2) <> "" Then
            Sheets(j).Select
            Cells(i, 20) = Range("F3").Value
        Else
            Cells(i, 20) = ""
        End If
    Next i
End If
Next j
MsgBox "订单号已经更新完毕！", vbInformation, "提示"
Application.ScreenUpdating = True

End Sub


Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For J=1 To Sheets.Count
    If Sheets(j).Name <> ActiveSheet.Name Then
       X=Range("A65535").End(xlUp).Row + 1
    Sheets(j).UsedRange.Copy Cells(X,1)
    End If
Next
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作簿已经合并完毕", vbInformation, "提示"
End Sub

• 新建菜单功能，如下图

• 使用的时候依次从左到右点击功能菜单

1. 先选取合并的文件

2. 将每张sheet中的指定单元格内容添加到表格的最左列

3. 再将所有sheet合并成一个sheet



• 完整代码文件

http://download.csdn.net/download/kirawoo/10175050