免费视频淫片aa毛片_日韩高清在线亚洲专区vr_日韩大片免费观看视频播放_亚洲欧美国产精品完整版

'有時(shí)，需要將多個(gè)Excel工作簿中的工作表合并到一個(gè)工作簿中。有多種合并工作簿的情形，下面先給出一種合并多個(gè)工作簿的VBA范例，供參考。

方法1
Sub CombineWorkbooks()
Dim wk As Workbook
Dim sh As Worksheet
Dim strFileName As String
Dim strFileDir As String
Dim nm As String
nm = ThisWorkbook.Name
strFileDir = ThisWorkbook.path & "\"
Application.ScreenUpdating = False
strFileName = Dir(strFileDir & "*.xls")
Do While strFileName <> vbNullString
If strFileName <> nm Then
MsgBox strFileName
Set wk = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29) '取主文件名,除掉.XLS
For Each sh In wk.Sheets
sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'工作表命名,以工作表所在文件名為類
If wk.Sheets.Count > 1 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strFileName & sh.Name
Else
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strFileName
End If
Next
wk.Close SaveChanges:=False
End If
strFileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

方法2
Sub UnWorksheets()
Application.ScreenUpdating = False
Dim lj As String
Dim dirname As String
Dim nm As String
Dim sname As String
Dim i As Integer, ii As Integer
lj = ActiveWorkbook.path
nm = ActiveWorkbook.Name
dirname = Dir(lj & "\*.xls") '查找文件
Do While dirname <> ""
If dirname <> nm Then
Workbooks.Open Filename:=lj & "\" & dirname '打開文件
ii = ActiveWorkbook.Sheets.Count '統(tǒng)計(jì)工作表個(gè)數(shù)
'復(fù)制新打開工作簿的每一個(gè)工作表到當(dāng)前工作表(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))最后一個(gè)后面
For i = 1 To ii
Workbooks(dirname).Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
Workbooks(dirname).Close False
End If
dirname = Dir
Loop
End Sub

'在同一文件夾下有多個(gè)工作簿，其中有一個(gè)用于匯總的工作簿，要求將除該匯總工作簿外的其它
'工作簿中的每一張工作表的數(shù)據(jù)匯總到該匯總工作簿中?
Sub UnionWorksheets()
Application.ScreenUpdating = False
Dim lj As String
Dim dirname As String
Dim nm As String
Dim i As Integer, ii As Integer
lj = ActiveWorkbook.path
nm = ActiveWorkbook.Name
dirname = Dir(lj & "\*.xls")
Cells.Clear

Do While dirname <> ""
If dirname <> nm Then
Workbooks.Open Filename:=lj & "\" & dirname
ii = ActiveWorkbook.Sheets.Count
Workbooks(nm).Activate
'復(fù)制新打開工作簿的每一個(gè)工作表的已用區(qū)域到當(dāng)前工作表
For i = 1 To ii
Workbooks(dirname).Sheets(i).UsedRange.Copy _
Range("a65536").End(xlUp).Offset(2, 0)
Next
Workbooks(dirname).Close False
End If
dirname = Dir
Loop

End Sub