Vba 如何将不同工作表中横向放置的相同列复制到单个工作表中？

我在一本工作簿中有50张工作表。列a、b、c、d与列e、f、g、h相同，但两个集合的行数/观察数可能不同。我需要在一张只有3列的表格中合并所有内容。我需要附加列名，从第三行开始复制和粘贴（值）（直到数据结束）。我也试着录制一个宏，但在这种情况下，我必须手动检查所有的表。有人能把我带到正确的方向吗？我对VBA很陌生，如果能给我一点帮助，我将不胜感激。我录制的复制2张图纸的宏如下所示：

Sheets("page 9").Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A67").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 9").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A132").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("A65").Select
Selection.End(xlUp).Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlDown).Select
Range("A197").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Selection.End(xlUp).Select
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Type"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Size"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Discount"
Range("A1").Select
 End Sub

---

我怀疑任何人都不能破解这个密码；当然我缺乏这种能力

宏记录器是学习新命令语法的好方法，但它不能生成“好”代码。它不知道你的目标，在你做的时候记录下每一个小步骤

花点时间学习Excel VBA。在internet上搜索“Excel VBA教程”，或访问一个好的图书馆或书店，然后选择Excel VBA入门。有很多选择，所以我相信你会找到适合你学习风格的东西。这项研究将很快回报你的投资

查看有关StackOverflow的excel vba问题。许多，也许是大多数，对你来说都不是当前感兴趣的。但是有些会展示一些你不知道但会有用的技术。也许学习VBA最困难的方面是发现什么是可能的。一旦知道存在语句X，就可以查找它并研究它的语法和功能

下面是演示相关代码的四个宏。将它们复制到工作簿并尝试。通过对宏记录器输出的研究，您不可能学会如何编写这些宏

A此宏将每个工作表的名称输出到即时窗口

Sub A()

  Dim InxWsht As Long

  For InxWsht = 1 To Worksheets.Count
    Debug.Print Worksheets(InxWsht).Name
  Next

End Sub

B这会在当前列表的末尾添加一个新工作表，并将其命名为“合并”。然后创建一个粗体的彩色标题行

范围（CellId）.Value

是访问单元格值的一种方法。我使用了

“A1”

作为单元格的Id，但这只是一个字符串，可能是在运行时生成的<代码>单元格（RowId，ColId）。值是另一种方式

RowId

必须是数字或整数变量

ColId

可以是数字、整数变量或列字母。我建议你要始终如一，不要像我一样混搭

我展示了两种指定范围的方法，以便在单个语句中设置整个标题行的粗体和彩色

如果我写了

Range（“A1”）.Value=“Date”

，则此语句将在活动工作表的单元格A1上运行。

范围

之前的

表示此语句对

With

语句中标识的工作表单元格A1进行操作。将

与

一起使用意味着我不必使用

选择

切换工作表，这是一个缓慢的命令

Sub B()

  Dim WhshtCons As Worksheet

  Set WhshtCons = Sheets.Add(After:=Sheets(Sheets.Count))

  WhshtCons.Name = "Consolidate"

  With WhshtCons

    .Range("A1").Value = "Date"
    .Cells(1, 2).Value = "Type"
    .Cells(1, "C").Value = "Size"
    .Cells(1, 4).Value = "Discount"

    .Range("A1:D1").Font.Bold = True
    .Range(.Cells(1, 1), .Cells(1, "D")).Font.Color = RGB(0, 128, 128)

  End With

End Sub

C这将输出除“合并”之外的每个工作表的单元格A1的值

subc（）
暗淡无光
对于InxWsht=1到工作表。计数
如果是工作表（InxWsht）。名称为“合并”，则
带工作表（InxWsht）
Debug.Print“工作表单元格A1”&.Name&“包含[”&”_
.Cells（1，1）.Value&“]
以
如果结束
下一个
端接头

D我不会解释这个宏，因为它比其他宏稍微高级一些。它演示了将数据列从所有其他工作表移动到工作表“合并”。我怀疑这是否接近你所寻求的，但它表明你所寻求的是可能的

Sub D()

  Dim ColConsCrnt As Long
  Dim InxWsht As Long
  Dim RowLast As Long
  Dim WhshtCons As Worksheet

  ColConsCrnt = 1

  Set WhshtCons = Worksheets("Consolidate")
  WhshtCons.Cells.EntireRow.Delete

  For InxWsht = 1 To Worksheets.Count
    If Worksheets(InxWsht).Name <> "Consolidate" Then
      With Worksheets(InxWsht)
        RowLast = .Cells(Rows.Count, "A").End(xlUp).Row
        WhshtCons.Cells(1, ColConsCrnt).Value = .Name
        .Range(.Cells(1, "A"), .Cells(RowLast, "A")).Copy _
                            Destination:=WhshtCons.Cells(2, ColConsCrnt)
      End With
      ColConsCrnt = ColConsCrnt + 1
    End If
  Next

End Sub

subd（）
暗淡的寒冷如长
暗淡无光
它能持续多久
将WhshtCons变暗为工作表
ColConsCrnt=1
设置WhshtCons=工作表（“合并”）
WhshtCons.Cells.EntireRow.Delete
对于InxWsht=1到工作表。计数
如果是工作表（InxWsht）。名称为“合并”，则
带工作表（InxWsht）
RowLast=.Cells（Rows.Count，“A”）.End（xlUp）.Row
WhshtCons.Cells（1，colconscrn）.Value=.Name
.Range（.Cells（1，“A”），.Cells（最后一行，“A”）。复制_
目的地：=WhshtCons.CELL（2，ColConsCrnt）
以
ColConsCrnt=ColConsCrnt+1
如果结束
下一个
端接头

---

欢迎收看节目。我希望你和我一样觉得这很有趣。

以上是合理的建议，我想补充一点，你确实需要学习两件事。第一种是VBA编程语言：这是关于变量和控制语句的使用，例如For…Next循环和条件语句（例如If…Then）。第二个是Excel使用的对象（如工作表和范围）及其属性和方法。宏记录器对前者帮助不大或没有帮助，但它可以帮助识别需要操作的对象（尽管它可能非常笨重和冗长），因此请尝试将其主要用于识别目的。基本上，我有两组需要复制的数据（每组3列）。每套都是并排放置的，我的母版纸只包含一套。上述代码仅适用于2张图纸。你能帮帮我吗？我必须同意，学习这门语言比到处设置代码片段要好。越快越好，谢谢@如果你已经意识到正确学习VBA的重要性，那么我已经成功了。我希望这些代码片段表明，一旦您了解VBA以及DMM所指出的Excel对象模型，您的目标就不难实现。祝你好运，学习愉快！

Sub D()

  Dim ColConsCrnt As Long
  Dim InxWsht As Long
  Dim RowLast As Long
  Dim WhshtCons As Worksheet

  ColConsCrnt = 1

  Set WhshtCons = Worksheets("Consolidate")
  WhshtCons.Cells.EntireRow.Delete

  For InxWsht = 1 To Worksheets.Count
    If Worksheets(InxWsht).Name <> "Consolidate" Then
      With Worksheets(InxWsht)
        RowLast = .Cells(Rows.Count, "A").End(xlUp).Row
        WhshtCons.Cells(1, ColConsCrnt).Value = .Name
        .Range(.Cells(1, "A"), .Cells(RowLast, "A")).Copy _
                            Destination:=WhshtCons.Cells(2, ColConsCrnt)
      End With
      ColConsCrnt = ColConsCrnt + 1
    End If
  Next

End Sub