Автоматическая передача данных при определенных условиях

Question

Это мой первый опыт использования этого сайта, и я был бы очень признателен, если бы кто-то помог мне написать код для Macro в Excel, чтобы сделать следующее.

Ситуация:

1. У меня есть 8 листов данных, называемых Data A, Data B, ..., Data H.
2. У меня есть 1 сводный лист под названием Summary.
3. На каждом из 8 листов данных, есть п количество идентификаторов из ячейки C8 и по горизонтали (т.е. C8, D8, E8, ...).
4. Каждый идентификатор связан с данными по ячейкам по вертикали. (то есть идентификатор в ячейке C8 имеет соответствующие данные по C9, C10, C13, C14, C15).

Для:

1. После активации макроса, перейдите Data A, начните с C8, чтобы проверить, если ячейка пуста или нет.
2. Если ячейка не пуста, копировать идентификатор (строка и номер комбинации) в ячейке C8 наряду с соответствующими данными (C9 к C10) и (C13 к C15) на Summary листа при температуре (A1 к A6).
3. После копирования перейти к следующей ячейке, которая является D8 на Data A листе, повторите шаг 2. На этот раз, назначение копирования будет B1 к B6 на Summary листе.
4. В любой момент, если ячейка в строке 8 на листе Data A пуста, перейдите к следующей спецификации (Data B).
5. Повторите шаги 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