如何将从不同工作表横向放置的同一列复制到单个工作表中？ [英] how do I copy same columns which are laterally placed from different worksheets into a single worksheet?

问题描述

我在工作簿中有50个工作表。列a，b，c，d与列e，f，g，h相同，但两个集合可能具有不同数量的行/观察值。我需要在一个单独的页面中只整合3列。我需要附加列名，从第3行开始复制和粘贴（值）（直到数据结尾）。我尝试录制一个宏，但在这种情况下，我必须手动完成所有的工作表。有人可以引导我走向正确的方向吗？我对VBA很新，有一点帮助将不胜感激。复制2张表的记录宏如下所示：

 表格（第9页）选择
范围A3：D3）。选择
范围（Selection，Selection.End（xlDown））。选择
 Selection.Copy 
 ActiveWindow.ScrollWorkbookTabs位置：= xlLast 
 Sheets.Add之后：= Sheets（Sheets.Count）
 Range（A2）。选择
 Selection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks _ 
：= False， = False 
 Selection.End（xlDown）。选择
范围（A67）。选择
 ActiveWindow.ScrollWorkbookTabs位置：= xlFirst 
表格（第9页）选择
范围（E3：H3）。选择
范围（Selection，Selection.End（xlDown））。选择
 Application.CutCopyMode = False 
 Selection.Copy 
 ActiveWindow.ScrollWorkbookTabs位置：= xlLast 
表格（Sheet1）。选择
 Selection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks _ 
：= False，Transpose：= False 
 Selection.End（xlDown）。选择
范围（A132）。选择
 ActiveWindow选择
范围（A65）。选择
 Selection.End（xlUp）。选择
范围（选择
 Range（Selection，Selection.End（xlDown））。选择
 Application.CutCopyMode = False 
 Selection.Copy 
 ActiveWindow.ScrollWorkbookTabs位置：= xlLast 
表单（Sheet1）。选择
 Selection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks _ 
：= False，Transpose：= False 
选择。结束（xlDown）。选择
范围（A197）。选择
 ActiveWindow.ScrollWorkbookTabs位置：= xlFirst 
表格（第10页）。选择
范围（E3 ：H3）。选择
 Range（Selection，Selection.End（xlDown））。选择
 Application.CutCopyMode = False 
 Selection.Copy 
 ActiveWindow.ScrollWorkbookTabs位置：= xlLast 
 Sheets（Sheet1）。选择
 Selection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks _ 
：= False，Transpose：= False 
 Selection.End （xlUp）。选择
范围（A1）。选择
 Application.CutCopyMode = False 
 ActiveCell.FormulaR1C1 =Date
范围（B1）。选择
 ActiveCell.FormulaR1C1 =Type
范围（C1 ）。选择
 ActiveCell.FormulaR1C1 =大小
范围（D1）。选择
 ActiveCell.FormulaR1C1 =折扣
范围（A1）。选择
 End Sub 
  

解决方案

我怀疑任何人都可以解密这段代码当然我缺乏能力。

宏录音机是学习新命令语法的好方法，但不会产生好代码。它不知道你的目标，记录每一个小步骤，因为你这样做。

花时间学习Excel VBA。在互联网上搜索Excel VBA教程或访问一个好的图书馆或书店，并选择一个Excel VBA入门。有很多选择，所以我相信你会发现适合你的学习风格的东西。这项研究将很快偿还您的投资。

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

以下是四个演示相关代码的宏。将它们复制到工作簿中并尝试。您无法从宏记录器输出的研究中学习如何编写这些宏。

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

 子A（）
 
 Dim InxWsht As Long 
 
对于InxWsht = 1 To Worksheets.Count 
 Debug.Print工作表（InxWsht）.Name 
下一个
 
 End Sub 
  / pre> 
 
 
  B 这将在当前列表的末尾添加一个新的工作表，并将其命名为Consolidate。然后它创建一个粗体，彩色标题行。 
 
 
 
 范围（CellId）.Value 是访问单元格值的一种方式。我使用A1作为单元格的Id，但这只是一个字符串，可能是在运行时构建的。 单元格（RowId，ColId）.Value 是另一种方式。  RowId 必须是数字或整数变量。  ColId 可以是数字，整数变量或列字母。我建议你一致，不要像我一样混合搭配。 
 
 
 
我展示了两种指定范围的方法，所以我可以将整个标题行设置为粗体，并在单个语句中进行着色。
 
 
 
如果我写了 Range（A1）。Value =Date这个语句将在活动工作表的单元格A1上运行。 。 范围表示在中标识的工作表的单元格A1的操作语句。使用与意味着我不必使用选择这是一个缓慢的命令来切换工作表。
  Sub B（）
 
 Dim WhshtCons As Worksheet 
 
设置WhshtCons = Sheets.Add ：= Sheets（Sheets.Count））
 
 WhshtCons.Name =Consolidate
 
使用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 ，D））Font.Color = RGB（0，128，128）
 
结束
 
 End Sub 
  
  C 输出除Consolidate之外的每个工作表的单元格A1的值。 
  Sub C（）
 
 Dim InxWsht As Long 
 
对于InxWsht = 1 To Worksheets.Count 
如果Worksheets（InxWsht）.Name<> Consolidate然后
与工作表（InxWsht）
 Debug.Print工作表单元格A1&名称& 包含[& _ 
 .Cells（1，1）.Value& ]
结束与
结束如果
下一个
 
结束Sub 
  
  D 我不会解释这个宏，因为它比其他的更先进。它演示将所有其他工作表的数据列移动到工作表Consolidate。我怀疑这是接近你寻求的，但它表明你所寻求的是可能的。
  Sub D（）
 
 Dim ColConsCrnt As Long 
 Dim InxWsht As Long 
 Dim RowLast As Long 
 Dim WhshtCons As Worksheet 
 
 ColConsCrnt = 1 
 
设置WhshtCons =工作表（Consolidate）
 WhshtCons.Cells.EntireRow.Delete 
 
对于InxWsht = 1 To Worksheets.Count 
如果Worksheets（InxWsht）.Name< ;> Consolidate然后
与工作表（InxWsht）
 RowLast = .Cells（Rows.Count，A）。End（xlUp）.Row 
 WhshtCons.Cells（1，ColConsCrnt）。 Value = .Name 
 .Range（.Cells（1，A），.Cells（RowLast，A））复制_ 
目标：= WhshtCons.Cells（2，ColConsCrnt）
结束
 ColConsCrnt = ColConsCrnt + 1 
结束如果
下一个
 
结束Sub 
  
欢迎编程。我希望你像我这样玩得很开心。
 
I have 50 worksheets in a workbook. columns a,b,c,d are same as columns e,f,g,h, but both sets might have different number of rows/observations. I need to consolidate all in a single sheet having only 3 columns. I need to append the column names, start copying and pasting (values) from 3rd row onwards (till end of data). I tried recording a macro too but in that case, I have to go through all the sheets manually. Can someone lead me to the right direction? I'm very new to VBA and a little help will be much appreciated. My recorded macro for copying 2 sheets goes like this:
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

解决方案
I doubt that anyone can decypher this code; certainly I lack the ability.

The Macro recorder is a great way of learning the syntax of new commands but it does not produce "good" code.  It does not know your objective and records every little step as you do it.

Take the time to study Excel VBA.  Search the internet for "Excel VBA Tutorial" or visit a good library or bookshop and select an Excel VBA Primer.  There are many to chose from so I am sure you will find something that suits your learning style.  This study will quickly repay your investment.

Look through the excel-vba questions on StackOverflow.  Many, perhaps most, will be of no current interest to you.  But some will show techniques you did not know about but which will be useful.  Perhaps the most difficult aspect of learning VBA is discovering what is possible.  Once you know statement X exists, you can look it up and study its syntax and functionality.  

Below are four macros that demonstrate relevant code.  Copy them to a workbook and try them.  You could not have learnt how to write these macros from a study of macro recorder output.

A This macro outputs the name of every worksheet to the Immediate Window.
Sub A()

  Dim InxWsht As Long

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

End Sub
B This adds a new worksheet at the end of the current list and names it "Consolidate".  It then creates a bold, coloured header line. 

Range(CellId).Value is one way of accessing a cell's value.  I have used "A1" as the cells's Id but this is just a string and could have been built at runtime. Cells(RowId, ColId).Value is another way.  RowId must be a number or an integer variable.  ColId can be a number, an integer variable or a column letter.  I suggest you be consistent and not mix and match as I have. 

I show two method of specifying a range so I can set the entire header row bold and coloured in single statements.

If I have written Range("A1").Value = "Date" this statement would have operated on cell A1 of the active worksheet.  The . before Range means this statement operates of cell A1 of the worksheet identified in the With statement.  Using With means I do not have to switch worksheets using Select which is a slow command.
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  This outputs the value of Cell A1 of every worksheet except "Consolidate". 
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 I will not explain this macro because it is somewhat more advanced than the others.  It demonstrates moving columns of data from all the other worksheets to worksheet "Consolidate".  I doubt this is close to what you seek but it demonstrates that what you seek is possible.
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
Welcome to programming.  I hope you find it as much fun as I do.

                        
这篇关于如何将从不同工作表横向放置的同一列复制到单个工作表中？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！