do while loop in VBA

Question

私は以下の表のようなデータを持っています。このデータセットの観測数は毎月変化します。列は同じままです。私は、行が空になるまで各行を通して自分のコードをループしたいと思います。私はdo whileループは適切だと思いますが、これまでにそれを実行するのに成功していませんでした（私は完全なVBA初心者です）。

2つのメモ：コードの最後の行にある[ペースト]の特殊ステップのために選択された2行目の範囲（次の観測行に移動します）と最後の範囲が選択されています各反復で観測の次の行に移動したい）。

Sample Data: 
Sex Age Race Total Cholesterol HDL-Cholesterol Systolic Blood Pressure Treatment for High Blood Pressure Diabetes Smoker 
F 50 AA 300 90 200 Y Y Y 
M 55 AA 290 90 200 Y Y Y 
F 50 AA 300 90 200 N N N 

私は、各非空の行をループする必要があるコード：

Sub ASCVD() 

    Sheets("Sheet1").Select 
    Range("A2:I2").Select 
    Selection.Copy 
    Sheets("Omnibus").Select 
    Range("C3").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    Range("B13").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Sheet1").Select 
    Range("J2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 


End Sub 

---

あなたの助けを事前にどうもありがとうございました!!!

Answer 1

目的の最終結果の例を作成すると、現時点で達成したいことは非常に不明です。とにかく、私はあなたがしたいすべてがあなたのデータを転置されたと仮定しています

を（今あなたが唯一の大きな絵が何であるか、実装の混乱ではなく記述している）、このコードは、仕事をしていません：

Sub ASCVD() 

    Dim Data() As Variant 
    Dim nrow As Integer 

    Data() = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Value 
    nrow = UBound(Data(), 1) 

    ThisWorkbook.Sheets("Omnibus").Activate 
    DoEvents 
    'Previous two lines needed so that the .Range(Cells(3.3), ... part works below 

    ThisWorkbook.Sheets("Omnibus").Range(Cells(3, 3), Cells(16 + 2, nrow + 2)) = Application.WorksheetFunction.Transpose(Data()) 
    'Cells(rownumber, columnnumber). Cells(1,1) is cell A1 
    'Cells(3, 3) is same as cell C3. 
    'Cells(16 + 2, nrow + 2) in your example case will be cell F18, the last cell of your data. 
    '+2 because you want to start from C3, meaning all your data is shifted two cells down and two cells right 

End Sub 

Answer 2

考え直しでは、何が本当に求めていることはdo-while文を使用する方法である：

Sub ASCVD() 

    Dim row As Integer 
    row = 2 

    Do While ThisWorkbook.Sheets("Sheet1").Cells(row, 1) <> "" 'Loop until first cell is empty 

     ThisWorkbook.Sheets("Sheet1").Range("A" & row & ":I" & row).Select 
     Selection.Copy 
     Sheets("Omnibus").Select 
     Range("C3").Select 
     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
      False, Transpose:=True 
     Range("B13").Select 
     Application.CutCopyMode = False 
     Selection.Copy 
     Sheets("Sheet1").Select 
     Range("J" & row).Select 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 

     row = row + 1 
    Loop 


End Sub 

コードループが行2、3、4、5を投げる....そしてそれはどこの行を見つけると停止します最初のセルは空です