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

我有一个工作簿中的50个工作表。 列a，b，c，d与列e，f，g，h相同，但是这两个集合可能具有不同数量的行/观察值。 我需要将所有内容合并到只有3列的单张纸上。 我需要追加列名，从第3行开始拷贝和粘贴（值直到数据结束）。 我也尝试过录制一个macros，但在这种情况下，我必须手动完成所有的工作表。 有人能带我走向正确的方向吗？ 我很新的VBA和一些帮助将不胜感激。 我录制的macros复制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 

Answer 1

我怀疑任何人都可以放弃这个代码。 当然，我缺乏这个能力。

macroslogging器是学习新命令语法的好方法，但不会产生“好”的代码。 它不知道你的目标，并logging你的每一个小步骤。

花时间学习Excel VBA。 在Internet上search“Excel VBA教程”或访问一个好的图书馆或书店，然后select一个Excel VBA入门。 有很多select，所以我相信你会find适合你的学习风格的东西。 这项研究将迅速偿还您的投资。

查看StackOverflow上的excel-vba问题。 许多，也许大多数，将不是你目前的兴趣。 但是有些会显示你不知道的技术，但是这些技术会很有用。 学习VBA最困难的方面也许是发现什么是可能的。 一旦你知道X语句存在，你可以查看它并研究它的语法和function。

以下是展示相关代码的四个macros。 将它们复制到工作簿并尝试它们。 你不可能从macros观logging器输出的研究中学会如何编写这些macros。

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

 Sub A() Dim InxWsht As Long For InxWsht = 1 To Worksheets.Count Debug.Print Worksheets(InxWsht).Name Next End Sub 

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

Range(CellId).Value是访问单元格值的一种方式。 我已经使用"A1"作为单元格的ID，但这只是一个string，可能已经在运行时build立。 Cells(RowId, ColId).Value是另一种方法。 RowId必须是数字或整数variables。 ColId可以是数字，整数variables或列字母。 我build议你保持一致，不要混为一谈。

我展示了两种指定范围的方法，这样我就可以在单个语句中将整个标题行设置为粗体和颜色。

如果我写了Range("A1").Value = "Date"此语句将在活动工作表的单元格A1上进行操作。 的. 在Range之前表示这个语句对With语句中标识的工作表的单元格A1进行操作。 使用With意味着我不必切换工作表使用Select这是一个缓慢的命令。

 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的值。

 Sub C() Dim InxWsht As Long For InxWsht = 1 To Worksheets.Count If Worksheets(InxWsht).Name <> "Consolidate" Then With Worksheets(InxWsht) Debug.Print "Cell A1 of Worksheet " & .Name & " contains [" & _ .Cells(1, 1).Value & "]" End With End If Next End Sub 

D我不会解释这个macros，因为它比其他的更先进。 它演示从所有其他工作表移动数据列到工作表“合并”。 我怀疑这与你所寻求的是接近的，但它表明你所寻求的是可能的。

 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 

欢迎来编程。 我希望你能find和我一样的乐趣。