VBA データを転記について

VBA初心者です。おしえてください。

受注一覧より顧客別一覧に転記するようにしたいのですが、
セルが空欄になるまで同じ作業を繰り返したいときはどのようなプログラムに
したらよろしいでしょうか。

いまはForを使用しています。数値は任意で入力したものです。

Sub 顧客別一覧()
Worksheets(2).Range("B2").Value = Worksheets(1).Range("B2").Value
rw = 5
Worksheets(2).Range("A5:F248").ClearContents

For cnt = 4 To 248
If Worksheets(1).Range("B" & cnt).Value = Worksheets(1).Range("B2").Value Then
Worksheets(2).Range("A" & rw).Value = Worksheets(1).Range("A" & cnt).Value
Worksheets(2).Range("B" & rw).Value = Worksheets(1).Range("C" & cnt).Value
Worksheets(2).Range("C" & rw).Value = Worksheets(1).Range("D" & cnt).Value
Worksheets(2).Range("D" & rw).Value = Worksheets(1).Range("E" & cnt).Value
Worksheets(2).Range("E" & rw).Value = Worksheets(1).Range("F" & cnt).Value
Worksheets(2).Range("F" & rw).Value = Worksheets(1).Range("G" & cnt).Value
rw = rw + 1
End If
Next


End Sub

シート２が顧客別で、シート１が受注一覧です。


宜しくお願いします。

No.2 回答者： WindFaller 回答日時： 2017/04/20 21:20

>セルが空欄になるまで同じ作業

#1さんの書いていたとおりで、Endプロパティでデータの最後の行を決めるのが一番良いと思います。空白が出るまで待つ方法(Do～Loop)は、表のような行数で処理できる場所は、若干の無駄な部分が出てきます。
また、ループしている中のまたループを設けてしまいました。無駄が減るからです。
それと、コード全体をみなおすと、フィルターを掛けて貼り付けたらどうかなって思います。

'//
Sub 顧客別一覧R()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rw As Long, cnt As Long
Dim i As Long, j As Long
Dim Lastrow As Long

Set sh1 = Worksheets(1)
Set sh2 = Worksheets(2)
Lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
　sh2.Range("B2").Value = sh1.Range("B2").Value
　rw = 5
　sh2.Range("A5:F" & Lastrow).ClearContents
　With sh2
　For cnt = 4 To Lastrow
　　If sh1.Range("B" & cnt).Value = sh1.Range("B2").Value Then
　　　j = 1
　　　For i = 1 To 7
　　　 If i = 2 Then j = j + 1
　　　 .Cells(rw, i).Value = sh1.Cells(cnt, j).Value
　　　 j = j + 1
　　　Next
　　　rw = rw + 1
　　End If
　Next
　End With
End Sub

No.1 回答者： fujillin 回答日時： 2017/04/20 17:46

こんにちは

VBAから範囲を調べるのに、キー操作のEND+矢印キーに相当する処理を利用することが多いです。

例えば、シート1のA4から連続して値のある最終行（次の行がが空白）を求めたいのであれば、
　Worksheets(1).Range("A4").End(xlDown).Row
といった感じです。（キー操作と同じです）
注）セルに式が入っていて計算結果が空白の場合は、値があるものと見なされます。

よく用いられるのは、途中に空白行があっても、最終的に値がある最下行を求めたい場合などで
　Cells(Rows.Count, 1).End(xlUp).Row
のように、シート上の最下セルからEND+↑で得られるセルを求めたりしますね。