使用多个工作表中的数据和不同的列长build立表格

我需要通过从15张（每次1张）中提取数据在一张纸上build立一张表格。 这些表单按date分隔。 date在一个单元格中。 其他数据“名称”，“class次”，“工作站”，“产品”，“包装”，“容量”和“性能”可以有不同的列长度（随着我们移动的date）。 在build立表格时，我想在每一行logging与从表格中获取的数据相匹配的date。 我从下面的代码开始，尝试select每个数据列的第一个数据单元格，并希望向下移动列直到出现空白单元格并select该部分将其传送到表格。 这将是一个很长的代码，我想一次正确地做一件事情，当它发展的时候，我会提出更多的问题。 这是我的第一个 – 我怎样才能调整代码，select列来select数据，直到我到一个空白的单元格信息？

谢谢，

Sub DataTable() Dim rcell1, rcell2, rcell3, rcell4, rcell5, recell6, rcell7, rcell8 As Long Worksheets("1").Activate Range("G4").Select rcell1 = Selection.Value ' Date Range("B9").Select Selection.End(xlDown).Select ' Name rcell2 = Selection.Value Range("C9").Select Selection.End(xlDown).Select ' Shift rcell3 = Selection.Value Range("D9").Select Selection.End(xlDown).Select ' Station rcell4 = Selection.Value Range("E9").Select Selection.End(xlDown).Select ' Product rcell5 = Selection.Value Range("F9").Select Selection.End(xlDown).Select ' Package rcell6 = Selection.Value Range("O9").Select Selection.End(xlDown).Select ' Capacity rcell7 = Selection.Value Range("Q9").Select Selection.End(xlDown).Select ' Performance rcell8 = Selection.Value End Sub 

Answer 1

这段代码应该给你很好的开始和循环遍历每个工作表（注意事件如何检查表的名字）。 您还需要更新我可能采用的任何范围引用。

 Sub DataTable() Dim wsTable As Worksheet Set wsTable = Worksheets("Table") 'change as needed Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets Select Case ws.Name Case Is = "1", "2", "3", "4", "5" ' etc. With ws Dim rngData As Range Set rngData = Union(.Range("B:F"), .Range("O:O"), .Range("Q:Q")) Dim lRow As Long Dim rCheck As Range For Each rCheck In Intersect(rngData, .Rows(1)) If .Cells(.Rows.Count, rCheck.Column).End(xlUp).Row > lRow Then lRow = .Cells(.Rows.Count, rCheck.Column).End(xlUp).Row End If Next Dim dDate As Date dDate = .Range("G4").Value With wsTable .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(lRow, 1).Value = dDate ws.Range("B9:F" & lRow).Copy .Range("B" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues ws.Range("O9:O" & lRow).Copy .Range("O" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues ws.Range("Q9:O" & lRow).Copy .Range("Q" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues End With End With End Select Next End Sub 

Answer 2

您不需要定义每个单独的列。 你应该如何使用“UsedRange”来select所有具有数据的列/行，并将这些值分配给一个二维数组，然后可以使用循环进行操作。