在特定条件下自动传输数据

这是我第一次使用这个网站，我非常感谢，如果有人可以帮我在Excel中编写一个macros的代码来执行以下操作。

情况：

1. 我有8个数据表称为Data A ， Data B ，…， Data H
2. 我有一个摘要表Summary 。
3. 在8个数据表的每一个上，从单元C8和水平方向（即C8 ， D8 ， E8 ，…）有n个ID。
4. 每个ID在单元格垂直下都有关联的数据。 （即单元格C8 ID在C9 ， C10 ， C13 ， C14 ， C15具有相关数据）。

去做：

1. 激活macros后，转到Data A ，从C8开始检查单元是否为空。
2. 如果单元格不为空，请将单元格C8的ID（string和数字组合）以及从（ C9到C10 ）和（ C13到C15 ）中的相关数据复制到（ A1到A6 ）的Summary表中。
3. 复制完成后，移动到Data A页上的下一个D8单元格，重复步骤2.这次复制的目的地是Summary表上的B1到B6 。
4. 在任何时候，如果Data A页上第8行的单元格为空，则移动到下一个数据表（ Data B ）。
5. 重复步骤2，3和4，直到在Data H表上find空单元格。

我希望我能find能够做到这一点的人。

这是我迄今为止（请理解我是VBA的初学者）：

 Dim ws As Worksheet Dim r As Integer For Each ws In Worksheets If ws.Name Like "Data *" Then With ws 'Assign a value to each character Dim AscCode As Short AscCode = Asc("A") End With Next ws End Sub 

Answer 1

未经testing：

 Sub CopyToSummary() Dim arrSheets, i As Integer Dim rngId As Range, rngSummary As Range arrSheets = Array("A", "B", "C", "D", _ "E", "F", "G", "H") Set rngSummary = ThisWorkbook.Sheets("Summary").Range("A1") For i = LBound(arrSheets) To UBound(arrSheets) Set rngId = ThisWorkbook.Sheets("Data " & arrSheets(i)).Range("C8") Do While Len(rngId.Value) > 0 With rngSummary .Value = rngId.Value .Offset(1, 0).Value = rngId.Offset(1, 0).Value 'etc for the other values End With Set rngSummary = rngSummary.Offset(0, 1) Set rngId = rngId.Offset(0, 1) Loop Next i End Sub