特定の条件で自動的にデータを転送する

Question

このウェブサイトを初めて使用しました。次のことを行うために、Excelでマクロのコードを書くのに役立つ人がいたら大変感謝します。

状況：

1. 私はData Aと呼ばれる8枚のデータ・シート、​​、...、Data Hを持っています。
2. Summaryという要約シートがあります。 8枚のデータシートのそれぞれに
がある N水平細胞 C8から、オンIDの数（すなわち C8、 D8、 E8、...）。
4. 各IDには、セルの下に垂直にデータが関連付けられています。 （すなわち、セルC8のIDは、C9,C10,C13,C14,C15）に関する関連データを有する。

実行します、マクロを起動する際に

1. をData Aに行き、セルが空であるかどうかをチェックするためにC8から始めます。セルが空でない場合、（A6からA1）でSummaryシート上（C10にC9）及び（C15からC13）からの関連データと共にセルC8におけるID（文字列と数字の組み合わせ）をコピー
2. 。 Data Aシート上D8ある次のセルに移動し、コピーした後
3. 、繰り返しステップ2.この時、コピー先はSummaryシート上B6からB1あろう。
4. Data Aシート上の8行目のセルが空の場合は、次のデータシート（​​）に移動してください。
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