VBA 特定の列に入っているテキストをコピペ

ExcelのVBAで、列に入っているテキストを自動的にコピーし、同列内の次のセルにペーストするコードを組みたいのですが、上手くできません。

範囲内の初めのセルに入っているテキストをコピー後、
次のセルが空白ならば貼り付け、
空白でない(別のテキストが入っている)場合は
そのセルに入っているテキストを新たにコピーし、次のセルに貼り付け…
このような作業を繰り返し行いたいです。
(数が膨大すぎてオートフィルだと時間がかかるので自動化したいです)

【イメージ】
元データ　　　　　作りたいイメージ
A列　　　　　　　　 A列

りんご　　　　　　　りんご
　　　　　　　　　　りんご
みかん　　　　　　　みかん
　　　　　　　　　　みかん　
バナナ　　　　　　　バナナ
イチゴ　　　　　　　イチゴ
　　　　　　　　　　イチゴ
　　　　　　　　　　イチゴ
メロン　　　　　　　メロン
(以下繰りかえし）

こんな感じになるようにしたいです。

以下今使用しているコードです
(テキスト2つめまでは正しく動くのですが、テキスト3つ目からコピーしてくれなくなり、2つ目のテキストを吐き出してしまいます)

Sub コピーペースト()
Dim sourceRange As Range
Dim destinationRange As Range
Dim i As Integer
Dim copyText As String

' コピー元の範囲を選択
Set sourceRange = Range("C7:C291")

' コピー先の開始セルを選択
Set destinationRange = Range("C8:C292")

' テキストのコピーペーストを繰り返すループ
For i = 1 To sourceRange.Rows.Count
If destinationRange.Cells(i).Value = "" Then
' コピー先のセルが空白の場合、コピー元のセルをペースト
destinationRange.Cells(i).Value = sourceRange.Cells(i).Value
Else
' コピー先のセルにテキストが入っている場合、そのテキストをコピーして下のセルにペースト
copyText = destinationRange.Cells(i).Value
destinationRange.Cells(i + 1).Value = copyText
End If
Next i
End Sub

よろしくお願いします。

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/06/14 12:08

else文の箇所が不要かとおもいます。

以下のようにしてください。

Sub コピーペースト()
Dim sourceRange As Range
Dim destinationRange As Range
Dim i As Integer
Dim copyText As String

' コピー元の範囲を選択
Set sourceRange = Range("C7:C291")

' コピー先の開始セルを選択
Set destinationRange = Range("C8:C292")

' テキストのコピーペーストを繰り返すループ
For i = 1 To sourceRange.Rows.Count
If destinationRange.Cells(i).Value = "" Then
' コピー先のセルが空白の場合、コピー元のセルをペースト
destinationRange.Cells(i).Value = sourceRange.Cells(i).Value
End If
Next i
End Sub

この回答へのお礼

ありがとうございます！
無事に解決できました！

お礼日時：2023/06/14 16:27

No.1 回答者： fujillin 回答日時： 2023/06/14 12:03

こんにちは

縦1列限定で良ければ、こんな感じでしょうか。

Sub test()
Dim v, c
Const scope = "C7:C291" ' ←対象セル範囲

v = ""
For Each c In Range(scope)
If c = Empty Then c.Value = v Else v = c.Value
Next c
End Sub