1 將選擇的工作簿中的第一張表合并到本工作簿的第一張工作表

Option Explicit

'將選擇的工作簿中的第一張表合并到本工作表的第一張工作表；

Sub mergeonexls()

On Error Resume Next

Dim books As Variant, booksN As Variant '選擇的簿和表

Dim booksNopen As Workbook, sheetN As Worksheet '打開的簿和表

Dim t As Workbook, ts As Worksheet '目標(biāo)簿和表

Dim cols As Integer, h As Long '列和行

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'打開文件選擇對(duì)話框

books = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx ;*.xlsm),*.xls; *.xlsx; *.xlsm,所有文件(*.*),*.*", _

Title:="Excel選擇", MultiSelect:=True)

Set t = ThisWorkbook

Set ts = t.Sheets(1) '指定合并到的工作表，這里是第一張工作表

cols = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column

For Each booksN In books

If booksN <> False Then

Set booksNopen = Workbooks.Open(booksN)

Set sheetN = booksNopen.Sheets(1) '指定所需合并工作表，這里是第一張工作表

h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row

If cols = 1 And h = 1 And Cells(1, 1) = "" Then

sheetN.UsedRange.Copy ts.Cells(1, 1)

Else

sheetN.UsedRange.Copy ts.Cells(h + 1, 1)

End If

booksNopen.Close

End If

Next

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

2 將選擇的工作簿中的第n張表全部對(duì)應(yīng)合并到本工作簿的第n張工作表

'將選擇的多個(gè)工作簿下的工作表依次對(duì)應(yīng)合并到本工作簿下的工作表

'即第一張工作表對(duì)應(yīng)合并到第一張，第二張對(duì)應(yīng)合并到第二張……

'如果選擇的工作簿中的工作表的數(shù)量多于本工作簿的工作表的數(shù)量，本工作簿會(huì)新建工作表然后再進(jìn)行復(fù)制；

Sub mergeeveryonexls()

On Error Resume Next

Dim books As Variant, booksN As Variant '選擇的簿和表

Dim booksNopen As Workbook, sheetN As Worksheet '打開的簿和表

Dim t As Workbook, ts As Worksheet '目標(biāo)簿和表

Dim cols As Integer, h As Long '列和行

Dim sheetNi As Integer '打開的開作表序號(hào)

Application.ScreenUpdating = False

Application.DisplayAlerts = False

books = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx ;*.xlsm),*.xls; *.xlsx; *.xlsm,所有文件(*.*),*.*", _

Title:="Excel選擇", MultiSelect:=True)

Set t = ThisWorkbook

For Each booksN In books

If booksN <> False Then

Set booksNopen = Workbooks.Open(booksN)

For sheetNi = 1 To booksNopen.Sheets.Count

If sheetNi > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count)

Set ts = t.Sheets(sheetNi)

Set sheetN = booksNopen.Sheets(sheetNi)

cols = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column

h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row

If cols = 1 And h = 1 And Cells(1, 1) = "" Then

sheetN.UsedRange.Copy ts.Cells(1, 1)

Else

sheetN.UsedRange.Copy ts.Cells(h + 1, 1)

End If

Next

booksNopen.Close

End If

Next

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

代碼分析

2.1 利用Application.GetOpenFilename方法打開“文件選擇”對(duì)話框，并定義一個(gè)工作簿對(duì)象集合；

2.2 對(duì)每個(gè)工作簿的操作定義一個(gè)外循環(huán)；

2.3 對(duì)工作簿中每一個(gè)工作表的操作定義一個(gè)內(nèi)循環(huán)；

2.4 對(duì)應(yīng)工作簿、工作表，將工作表的UsedRange復(fù)制到本工作簿對(duì)應(yīng)的工作表。

3 合并工作簿中全部工作表的數(shù)據(jù)到第一個(gè)工作表

有如下工作簿，需要將其中的全部工作表保持格式合并到一個(gè)新的工作簿的一個(gè)工作表中。

Sub 合并工作表()

Dim NewSht As Worksheet, ActiveWb As Workbook

Set ActiveWb = ActiveWorkbook '將活動(dòng)工作簿賦值給變量ActiveWb

Set NewSht = Workbooks.Add.Sheets(1) '新建一個(gè)工作簿，將它的第1個(gè)工作表賦值給變量NewSht(此時(shí)活動(dòng)工作簿不再是ActiveWb所代表的工作簿了)

'聲明一個(gè)Worksheet型變量Sht,用于For Each...Next循環(huán)語句的變量，以及一個(gè)Integer型的變量，作為計(jì)數(shù)器使用，代表被合并的工作表數(shù)量

Dim Sht As Worksheet, i As Integer

For Each Sht In ActiveWb.Worksheets '遍歷ActiveWb的每一個(gè)工作表(使用Worksheets而不是Sheets，會(huì)跳過圖表)

i = i + 1 '累加變量

Sht.UsedRange.Copy '復(fù)制sht工作表的已用數(shù)據(jù)區(qū)域

'如果變量i的值等于1，那么取工作表NewSht的B1賦值給變量rng，否則取B列最后一個(gè)非空單元格的下一個(gè)單元格賦值給變量rng，此變量為粘貼復(fù)制單元格的開始位置

Set rng = IIf(i = 1, Range("B1"), NewSht.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0))

rng.PasteSpecial Paste:=xlPasteFormats '選擇性粘貼格式

rng.PasteSpecial Paste:=xlPasteColumnWidths '選擇性粘貼列寬

rng.PasteSpecial Paste:=xlPasteValues '選擇性粘貼數(shù)值

rng.Offset(0, -1).Resize(Sht.UsedRange.Rows.Count, 1).Merge '合并首列

rng.Offset(0, -1) = Sht.Name '將原工作表名稱寫入合并單元格

Next Sht

'如果變量i大于0，那么將A列的非空單元格添加邊框

If i > 0 Then Application.Intersect(Range("a:a"), NewSht.UsedRange).Borders.LineStyle = xlContinuous

End Sub

執(zhí)行VBA代碼后，合并效果如下：

• '代碼思路分析：

• '先創(chuàng)建一個(gè)工作簿，然后使用For Each...Next語句遍歷數(shù)據(jù)源所在工作簿的每個(gè)工作表

• '在循環(huán)語句中，對(duì)每個(gè)工作表的UsedRange執(zhí)行復(fù)制，并分三次復(fù)制到目標(biāo)工作表中

• '第一次復(fù)制時(shí)只復(fù)制值，第二次復(fù)制時(shí)復(fù)制數(shù)據(jù)的列寬，從而確保合并后的工作表與數(shù)據(jù)源的列寬一致，避免不會(huì)看不到單元格的某些數(shù)據(jù)

• '第三次復(fù)制時(shí)則復(fù)制格式信息(復(fù)制格式時(shí)不包括列寬，所以需要分兩次操作)

• '為了方便查看合并后的數(shù)據(jù)來源哪個(gè)工作表，本例復(fù)制數(shù)據(jù)時(shí)放在B列開始的區(qū)域，A列存放數(shù)據(jù)源的工作表名稱