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

Question

这是我第一次使用这个网站，如果有人能帮我在Excel中为宏编写代码，我会非常感激的。

情况：

Data H.

• I有8张数据表名为Data A、Data B、.，

1. 有8张数据表名为Data A、Data B、.每个数据表中都有一个名为Summary.
2. On的概要表，从单元格C8到水平上有n个ID (即C8、D8、E8、.).

H 115每个ID在单元格下垂直关联数据。(即单元格中的ID有关于C15).、C10、C13、C14、C9的相关数据)

去做：

1. 激活宏后，转到Data A，从C8开始检查单元格是否为空。如果单元格不是空的，将单元格A6).
2. After中的ID (字符串和数字组合)以及相关数据从(C9到C10)和(C13到C15)复制到Summary工作表(A1到C8复制)，移动到D8上的下一个单元格，在d41工作表上重复步骤2。这一次，复制的目标是D 42到Summary工作表上的d43。H 245H 146。如果(Data B).
3. Repeat工作表第8行上的单元格为空，则移动到下一个数据表Data A步骤2、3和4，直到在Data H工作表上找到空单元格。

我希望我能找到一个能做到这一点的人。

以下是我到目前为止所拥有的(请理解我是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

未经测试：

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