Excel多个工作表（Sheet）合并

这里是指多个工作表不是指工作簿

我有一个工作簿里有200个工作表（Sheet1-Sheet200）。这200个sheet里都是表格。内容区域里的表头和格式，行数，列数都相同，唯有单元格内的内容不同。

我现在想在Sheet201里收集Sheet1-Sheet200里的所有表格内容。

用复制粘贴肯定原始，笨拙，工作量又大。

Sub 合并sheets()

n = 6 '源表个数

nstart = 8 '每个单表数据的起始行数

k = nstart '目标表的行标

For i = 1 To n

irow = nstart '行标

While Sheets(i).Cells(irow + 1, 2) <> "" '以第2列数据为结束标示,确定源表的行数

irow = irow + 1

Wend

Sheets(i).Rows(nstart & ":" & irow).Copy '复制源数据行

Sheets(n + 1).Activate

Sheets(n + 1).Cells(k, 1).Select

ActiveSheet.Paste '粘贴数据

k = k + irow - nstart + 1

Next i

End Sub

Sub 宏1()

n = 200 '

k = 1

For i = 1 To n

j = 1

While Sheets(i).Cells(j, 1) <> ""

l = 1

While Sheets(i).Cells(j, l) <> ""

Sheets(n + 1).Cells(k, l) = Sheets(i).Cells(j, l)

l = l + 1

Wend

k = k + 1

j = j + 1

Wend

Next i

End Sub

Sub 合并sheets()

n = 6 '源表个数

nstart = 8 '每个单表数据的起始行数

k = nstart '目标表的行标

For i = 1 To n

irow = nstart '行标

While Sheets(i).Cells(irow + 1, 2) <> "" '以第2列数据为结束标示,确定源表的行数

irow = irow + 1

Wend

Sheets(i).Rows(nstart & ":" & irow).Copy '复制源数据行

Sheets(n + 1).Activate

Sheets(n + 1).Cells(k, 1).Select

ActiveSheet.Paste '粘贴数据

k = k + irow - nstart + 1

Next i

End Sub

用单元格是否为空判断结尾不好

Sub Macro1()

' Macro1 Macro

CNTR = 1

For I = 1 To Sheets.Count-1

Sheets(I).Select

ActiveCell.SpecialCells(xlLastCell).Select

INTR = Selection.Row

INTC = Selection.Column

Range(Cells(1, 1), Cells(INTR, INTC)).Select

Selection.Copy

Sheets(201).Select

Cells(CNTR, 1).Select

ActiveSheet.Paste

CNTR = CNTR + INTR

Next I

End Sub

若你的工作表表名确实为sheet1-201,就不用宏，先复制一个表头到sheet201，则

sheet201a2=indirect("sheet"&row(a1)&"!"&char(64+column())&row(a1)),分别向下、向右填充该公式至相应的数据末端即可

**************************************************************************************

Sub 生成工资条()

Application.DisplayAlerts = False '关闭提示

Application.ScreenUpdating = False '关闭屏幕更新，加快程序运行。

For I = 5 To 8

Worksheets(I).Select

ActiveSheet.UsedRange.Select '选中有数据的区域

Selection.Copy '复制

Worksheets(N + 1).Select '选中sheet201

Range("a65536").End(xlUp).Offset(1, 0).Select '找到sheet201的最大行+1的位置

ActiveSheet.Paste '贴贴

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub