excel多工作表复制到新工作簿excel一段代码把几百个相同结构的表

导读可是，不能没有然后了，必须奋起直追，马上投入学习。我最担心的就是，很多朋友只是暂时的刺痛，过几天依然麻木的盲目的过着三点一线的生活，机械，低效，乏味，郁闷，....

可是，不能没有然后了，必须奋起直追，马上投入学习。我最担心的就是，很多朋友只是暂时的刺痛，过几天依然麻木的盲目的过着三点一线的生活，机械，低效，乏味，郁闷，却一直不知道挣脱，或者压根就没想过要换个活法。

而要跳脱现在的一成不变的局面，唯一的最有效的方法，就是学习！

找准一个精准的目标，开始学习！

昨天，我们说过用一段代码把几百个相同结构的工作表，都快速复制粘贴到一个总表里。

很多朋友说这个功能好。有个朋友提到说，能否把表名作为总表里单独一列存储起来。

一个工作簿里有218个相同结构的工作表，数据记录条数不同，有的表是500个记录，有的是1000个记录，有的呢有3500个记录，诸如此类。

总表的结构是这样的

这行标题是自己提前输入好的↓

1

ALT F11，插入，模块

在模块里输入如下代码，或复制粘贴如下代码（下面提供了代码）。然后关闭这个窗口。

以下代码满足于当前工作簿里所有分表的结构一样，数据记录从第2行开始，列数可以若干列，同时要求把分表的名称作为单独一列存起来（本例里就是总表里的“城市”列）

Sub 带表名复制()

Dim rg As Range

Dim sh As Worksheet

Dim Row1, row2

Sheets("总表").Range("2:1048576").Clear

For Each sh In Worksheets

With Sheets("总表")

If sh.Name <> "总表" Then

row1 = .Range("B" & Rows.Count).End(xlUp).Row 1

Set rg = sh.UsedRange.Offset(1, 0)

rg.Copy .Cells(row1, 2)

row2 = .Range("B" & Rows.Count).End(xlUp).Row

.Range("A" & row1 & ":A" & row2) = sh.Name

End If

End With

Next

End Sub

2

插入，形状，圆角矩形，在矩形里输入文字“汇集”，设置好字体格式以及矩形的填充色、边框颜色以及形状阴影等。

右键单击矩形，指定宏，选中“带表名复制”这个宏，确定

3

单击这个矩形按钮，即可立即1秒把数百个分表的数据汇集到总表里。

简直帅爆了，有没有！

不要嘲笑我，不懂代码，此刻

哥（姐）啊，也可以把你秒成渣！