数式による空白は無視して値が入力されている行までコピー

画像の、①から⑥の表に入力されているデータを番号順にsheet2へ値のみ貼り付ける作業をマクロで行いたいと考えています。

・各番号の範囲に入力されているデータの行数はランダムです。
・数式による空白は無視してコピー、sheet2のA2最終行へ値のみペーストしたいです。
・必ず番号順にsheet2へペーストしたいです。
・Jのデータは無視します。

自分でもやってみたのですが、上から順にコピペを繰り返す方法だと、①から②までが選択されてしまったり、空白を無視して選択をすると①から④の最終行まで選択されてしまいました。

わかりにくくてすみません。
何かいい方法があれば教えて頂きたいです。

質問者からの補足コメント

• 7x3の固定です。一つのブロック内で7行以上3列以上にならない表です。
  入力行数が7行未満になると残りの行に数式による空白ができます。
  その空白は無視して値のみコピーし番号順にペーストしたいです
  表の枠線も無視してペーストします
  
  イメージです↓
  
  Sheet1
  　 ABC DEF
  1値値値 値値値
  2値値値 値(空白)値
  3値値値 空　白
  4空　白 値値値
  5空　白 空　白
  6値値値 空　白
  7空　白 値値(空白)
  
  sheet2
  　ABC
  1値値値　←ここからブロック①
  2値値値　
  3値値値　
  4値値値　
  5値値値　←ここからブロック②
  6値　値
  7値値値
  8値値
  
  
  ブロック②のDEFのように、Eのみ数式による空白ができる場合は、
  その空白を無視しません。
  ペーストする時は、数式による空白ではなく、ただの空白としてペーストしたいです。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/01/16 06:15

No.4 ベストアンサー 回答者： fujillin 回答日時： 2020/01/17 10:24

こんにちは

7x3のブロック内で1行（＝3セル）全部が空白の行は上に詰めたいというご希望のように解釈しました。

＞sheet2のA2最終行へ値のみペーストしたいです。
『すでにsheet2に何らかのデータが存在しているので、その最終行から追加してゆく』とも読めるのですが、ひとまずsheet2のA1セルから下へコピーするようにしてあります。
また、事前にsheet2全体をクリアしていますので、「追加してゆく方式」になさりたい場合は、このクリア処理を削除し、sheet2のスタートセル(＝変数r2)の値を最終行にセットすれば、自動的に追加してゆくようになります。

＞Jのデータは無視します。
「Ｊのデータ」の意味するものが何なのか理解できませんでした。
ですので、これに関しては対応していません。

というわけで、以下ではいかがでしょうか？

Sub Sample()
Const sheet1 = "Sheet1" ' ←元データのシート名
Const sheet2 = "Sheet2" ' ←コピー先のシート名

Dim i, j, r1 As Range, r2 As Range
Set r1 = Worksheets(sheet1).Range("A1:C7")
Set r2 = Worksheets(sheet2).Range("A1:C7")
r2.Worksheet.Cells.Clear

For i = 0 To 1
For j = 0 To 2
　r2.Offset(i * 21 + j * 7).Value = r1.Offset(i * 8, j * 3).Value
Next j
Next i

With r2(1).Offset(0, 3).Resize(43, 1)
　.FormulaR1C1 = "=IF(COUNTBLANK(RC[-3]:RC[-1])=3,""E"","""")"
　.Value = .Value
　.SpecialCells(xlCellTypeConstants).EntireRow.Delete
End With
End Sub

この回答へのお礼

ありがとうございます！この方法でできました。

お礼日時：2020/01/19 11:03

No.3 回答者： GooUserラック 回答日時： 2020/01/16 11:23

固定で良ければ以下のような感じはいかがでしょうか？

Sub Sample()

Dim 元行 As Long
Dim 元列 As Long
Dim 先行 As Long
Dim データ As Variant
　Application.ScreenUpdating = False
　先行 = 1
　For 元行 = 1 To 9 Step 8
　　For 元列 = 1 To 7 Step 3
　　　Sheets("Sheet1").Select
　　　データ = Range(Cells(元行, 元列), Cells(元行 + 6, 元列 + 2))
　　　Sheets("Sheet2").Select
　　　Range(Cells(先行, 1), Cells(先行 + 6, 3)) = データ
　　　先行 = 先行 + 7
　　Next
　Next
　Application.ScreenUpdating = True

End Sub

この回答へのお礼

ブロック数も固定です。
こちらの方法だと上に詰めるのができませんでした。
説明不足ですみません。
この方法もこのパターンの時に使いたいと思います。
ありがとうございました！

お礼日時：2020/01/19 11:06

No.2 回答者： GooUserラック 回答日時： 2020/01/16 10:51

ブロック数も６個固定でしょうか？

No.1 回答者： GooUserラック 回答日時： 2020/01/15 21:07

７×３セルをブロックにして張り付けていく感じのようですが、①～⑥の位置は固定なのでしょうか？