Excel – 用于添加列ID的VBA代码，然后将所有工作表合并到工作表中

我有一个多张纸的Excel文件。 每张纸都有相同的格式，例如：

表1：名称“01”

╔══════╦═══════╗ ║ Name ║ Value ║ ╠══════╬═══════╣ ║ a ║ 1 ║ ║ b ║ 2 ║ ╚══════╩═══════╝ 

工作表2：名称“02”

 ╔══════╦═══════╗ ║ Name ║ Value ║ ╠══════╬═══════╣ ║ c ║ 3 ║ ║ d ║ 4 ║ ╚══════╩═══════╝ 

我想将所有这些表单合并到一个新表单中，如：

表结合：名称“结合”

 ╔══════╦═══════╦════╗ ║ Name ║ Value ║ ID ║ ╠══════╬═══════╬════╣ ║ a ║ 1 ║ 01 ║ ║ b ║ 2 ║ 01 ║ ║ c ║ 3 ║ 02 ║ ║ d ║ 4 ║ 02 ║ ╚══════╩═══════╩════╝ 

我发现一个VBA代码来组合所有工作表，但是我不知道如何在组合之前为每个工作表添加一个列ID。 VBA代码是：

 Sub Combine() Dim J As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "Combined" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For J = 2 To Sheets.Count Sheets(J).Activate Range("A1").Select Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next End Sub 

如果有人能帮助我，非常感谢。

Answer 1

假设只有两个列，如你在你的问题所示。 这应该工作。

 Sub Combine() Dim J As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "Combined" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For J = 2 To Sheets.Count Sheets(J).Activate Range("A1").Select Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Sheets(1).range(sheets(1).cells(Sheets(1).Range("C65536").End(xlUp).Row, 3), sheets(1).cells(Sheets(1).Range("A65536").End(xlUp).Row, 3)) = Sheets(j).name Next End Sub 

Answer 2

我在Excel VBA的初学者级别，因此有兴趣尝试在论坛中build议的各种代码片段。 我只想发表评论，但没有要求评论意见。所以把我的观点作为答案。

在尝试代码@DiegoAndresJAY时，C列的值与列A和列B中的值不一致。稍微调整下面一行即可得出正确的alignment方式。 也许是一个疏忽。

  Sheets(1).range(sheets(1).cells(Sheets(1).Range("C65536").End(xlUp).Row+1, 3), sheets(1).cells(Sheets(1).Range("A65536").End(xlUp).Row, 3)) = Sheets(j).name 

谢谢