特定の列範囲の中で最終列を指定

お世話になります。
以前質問した中で、別シートにデータを5列づつ
下に追加していくにはどうしたら良いかと言う質問をさせていただきました。

https://oshiete.goo.ne.jp/qa/11051972.html

上記回答で解決したのですが、
For j = 4 To .Cells(i, 1).End(xlToRight).Column Step unit
だと繰り返したくない列も動いてしまい、
繰り返す列範囲がD～W列のため
For j = 4 to 24 Step unit　に変更しました。
すると今度は空白がある行も転記してしまい、困っています。

繰り返す範囲はD～W列まで5列毎に繰り返す
5列毎の最初のセルが空白か[0]であれば転記しない

どうぞよろしくお願いします。

No.2 ベストアンサー 回答者： 白亜気 回答日時： 2019/04/08 22:32

似ていますが、、、、

Sub Copies()
Const SRow = 3: Dim LRow As Long
Dim sht1 As Worksheet: Dim sht2 As Worksheet
Dim i As Long, j As Long, k As Long
Const UWide = 5
'===================
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
'===================
Application.ScreenUpdating = False
With sht1
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(SRow, 1).Resize(1, 3 + UWide).Copy sht2.Cells(1, 1)
k = 2
For i = SRow + 1 To LRow
For j = 4 To 23 Step UWide
If WorksheetFunction.CountA(.Cells(i, j).Resize(1, UWide)) > 0 Then
.Cells(i, 1).Resize(1, 3).Copy sht2.Cells(k, 1)
.Cells(i, j).Resize(1, UWide).Copy sht2.Cells(k, 4)
k = k + 1
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub

この回答へのお礼

遅くなってすみません。
理想通りにできました！
ありがとうございました！

お礼日時：2019/04/10 00:16

No.1 回答者： fujillin 回答日時： 2019/04/08 10:59

こんにちは

ほとんど理解していませんが・・・

＞繰り返す範囲はD～W列まで5列毎に繰り返す
＞5列毎の最初のセルが空白か[0]であれば転記しない

最初の条件はループの範囲を
　Application.Min(.Cells(i, 1).End(xlToRight).Column, 23)
などにしておけば良さそう。

二番目の条件は、ループ内の始めに
　Cells(row, i).Value　
（↑rowは行に当たる変数：何を使っているのか知らないので）
を見て判断する処理を入れるだけで宜しいかと。

この回答へのお礼

ありがとうございました！

お礼日時：2019/04/10 00:15