エクセルVBAでセルの削除をしたい

1つのシートに別シートから抽出した各誕生月別の表が12個あります（画像の左表）。
（画像では各月3行ずつになっていますが実際にはもっとあります）

E列、J列、O列には氏名が空白なら「blank」と表示していて、
「blank」が表示されている各月のセル（名前、誕生日、年齢）を削除して上方向にシフトしたものを別シートに貼り付けたいです（画像の右表）。
（空白セルを表示させずに1枚の用紙に印刷するためです。）

毎回各月の空白セルのみを選択して削除→上方向にシフトをするのは手間がかかるのでマクロでやりたいです。

以前「blank」と表示されていれば行ごと非表示にするというマクロは修正したことがあるのですが、そのときは1つのシートに1つの表だったため行単位でできましたが、今回は行単位で操作できないため、やり方が分かりません。

「条件を選択してジャンプ」→「空白セル」も試しましたが、別シートから抽出（値で貼り付け）しているためか空白に見えるセルでも空白セルの認識をしてくれませんでした。

よろしくお願いいたします。

No.1 ベストアンサー 回答者： t_fumiaki 回答日時： 2017/10/19 03:32

左をSheet1、右をSheet2　とした場合の例。

このサイトは字下げが出来ないので、見ずらいです。

Sub WK()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")

Sh2.Cells.Clear 'Sheet2をクリア

For Cnt1 = 1 To 3

列 = (Cnt1 - 1) * 5 + 1

END1 = Sh1.Cells(65536, 列).End(xlUp).Row '最終行取得
行 = 0
For Cnt2 = 1 To END1

　　’E,J,Oがblankで無ければ、コピー実行
If Sh1.Cells(Cnt2, 列 + 4) <> "blank" Then
行 = 行 + 1
Sh1.Cells(Cnt2, 列).Copy
Sh2.Cells(行, 列).PasteSpecial (xlPasteAll)

Sh1.Cells(Cnt2, 列 + 1).Copy
Sh2.Cells(行, 列 + 1).PasteSpecial (xlPasteAll)

Sh1.Cells(Cnt2, 列 + 2).Copy
Sh2.Cells(行, 列 + 2).PasteSpecial (xlPasteAll)

Sh1.Cells(Cnt2, 列 + 3).Copy
Sh2.Cells(行, 列 + 3).PasteSpecial (xlPasteAll)

Sh1.Cells(Cnt2, 列 + 4).Copy
Sh2.Cells(行, 列 + 4).PasteSpecial (xlPasteAll)

End If
Next Cnt2
Next Cnt1
Application.StatusBar = False
End Sub

この回答へのお礼

教えて頂いた記述でできました！
ありがとうございました。

お礼日時：2017/10/19 14:53