【VBA】行間を詰めるマクロが組みたい（結合セルあり）

Question

前提

excel　2019にて、行間を削除する軽量なマクロが組みたいです。
自分が組んだ結果、無駄に処理が重く軽量化したいです。

質問内容、文法等不明瞭な点あるかと思いますが何卒ご指導お願い致します。

実現したいこと

以下の添付画像のように、AB列を変更せずに行間を詰め、
最後にAD列に「円」を入れたいです。
AB列の数字は1～30まで（20列目～49列目まで）あります。

※22.12.01. 23:45追記　見切れてい為、画像3枚目追加します。大変失礼いたしました。
下部のレイアウトが崩れないようにしたいです。

VBA

ソースコード

Sub 行削除()

    Application.ScreenUpdating = False
    
    Dim RowCnt As Integer
    
    For RowCnt = 1 To 30
     
        Dim i As Long
        For i = 20 To 48
        
            If Cells(i, 3) = "" Then
            Range(Cells(i, 3), Cells(i, 30)) = ""
        
            Range(Cells(i + 1, 3), Cells(i + 1, 33)).Copy
            Range(Cells(i, 3), Cells(i, 30)).PasteSpecial xlPasteAllExceptBorders
            
            Range(Cells(i + 1, 3), Cells(i + 1, 33)) = ""
        End If
        
        
        Next i
        
    Next
    
    Range("AC20:AC49") = "円"
    
    
End Sub

試したこと

Range("").End(xlDown)でデータ取得し横へ選択しコピー等検討しましたが
取得した点から横軸のセルを選択しコピーする処理が書けませんでした。
ご指導お願いいたします。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Comments

[hatena19]

A列とB列, C～F列, ・・・・AD～AG列は、セル結合しているのでしょうか。

> AD列に「円」を入れたいです。
AH列にすでに「円」が入ってますが、AD～AG列の数値の後に円を付けたいということでしょうか。

[METEORS]

コメントありがとうございます。補足させていただきます。
①A～B、C～F、G～L、M～T、U～W、Y～AB、AD～AG列がそれぞれ結合されております。
（帳票ソフトの関係上です）
②AC列、AH列に元々「円」が入っております。
　行を詰めた後、空白となった下の方の行のAC列、AH列に「円」が残る形にしたいです。

何卒宜しくお願い致します。
　

Answer 1

C20から最終行(画像なら27)までの範囲でC列が空白のC～AH列までの行を削除して上に詰める処理でどうでしょう。
下記のようなコードで可能です。

Public Sub Sample()
    Dim rng As Range, r As Range, delr As Range
    Set rng = Range("C20:AH" & Cells(50, "C").End(xlUp).Row)
    
    For Each r In rng.Rows
        If r.Cells(1).Value = "" Then
            If delr Is Nothing Then
                Set delr = r
            Else
                Set delr = Union(delr, r)
            End If
        End If
    Next
    delr.Delete Shift:=xlUp
End Sub

Comments

[METEORS]

ご回答いただき本当にありがとうございます。
試しに動作させてみたところかなり動作早く感激しております。
頂きましたコード、参考にさせて頂きます。