Sub 多个工作簿的表1合并到某一工作簿()
Dim fd As FileDialog
Dim appexl As Excel.Application
Dim strfilepath As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = ThisWorkbook.Path
.Filters.Clear
.Filters.Add "Microsoft Excel", "*.xls;*.xlsx"
.AllowMultiSelect = True
If .Show = -1 Then
Dim vrtSelectedItem As Variant
Dim i As Integer
i = 1
For Each vrtSelectedItem In .SelectedItems
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
tempwb.Worksheets(1).Copy Before:=ThisWorkbook.Worksheets(i)
Application.ActiveWorkbook.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls", "")
tempwb.Close savechanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
strfilepath = ThisWorkbook.Path & "\总表.xls"
If Dir(strfilepath) <> "" Then Kill strfilepath
CopyFile ThisWorkbook.FullName, ThisWorkbook.Path & "\总表.xls", True
ActiveWorkbook.Close savechanges:=False
appexl.Quit
Set fd = Nothing
Set tempwb = Nothing
Set appexl = Nothing
End Sub
执行的结果是:
我要的结果是:关闭这个窗口。