VBA 最終行の取得がうまくいかず上書きされてしまいます。

No4です。

＞1．レイアウトですが、15行目、30行目にスペースがあります。なので設備2は16行目から、設備3は31行目から始まります。このスペースは削除可能です。

回答：B列に日付が入っていれば問題ないので、このままで構いません。


＞2.歯抜けを防ぐため非表示のB列5行目～44行目まで日付を入力しています。
＞3.B列には歯抜けを防ぐため日付が入ってるため空のセルはありません。
抽出条件はD列のNo.が30000以下の場合 A列に●が入るようにしてあり、その●がついた行だけを月集計のシートに転記していきたいのですが、可能でしょうか？

回答：上記の件、了解しました。
下記へアップしました。
不明点があれば、補足してください。
https://ideone.com/4OUJYW

No1です。

補足ありがとうございました。
最終確認です。

１．レイアウト確認
日報シートのレイアウトは、以下の内容で間違いないでしょうか。
1行～2行　　　設備1
3行～4行　　　設備1の見出し
5行～14行　　 設備1のデータ
15行～17行　　設備2
18行～19行　　設備2の見出し
20行～29行　　設備2のデータ
30行～32行　　設備3
33行～34行　　設備3の見出し
35行～44行　　設備3のデータ

マクロが転記対象とするのは、以下の
5行～14行　　 設備1のデータ
20行～29行　　設備2のデータ
35行～44行　　設備3のデータ
になります。

２．設備ごとの処理
各設備のデータは、前詰めで格納されている前提です。歯抜けのデータ行はないものとします。
歯抜けの行があった場合は、その設備の処理を打ち切り、次の設備の処理に移ります。

例
設備1で
5行　データ有
6行　空行
7行　データ有
の場合、6行で歯抜けがあるので、5行のみ転記します。
7行目以降は転記せず、設備2の処理に移ります。

３．データの有無の判定
Ｂ列にデータがある場合、データ有の行と判定します。（Ａ列は参照しません）
Ｂ列が空の場合は、Ｃ列等にデータがあっても、空行とみなします。

上記の仕様で、宜しいでしょうか。

j を Static にしたら？

部分的な回答です

>シート【1日】は問題なく転記出来たのですが、【2日】を転記すると【1日】のデータに上書きされてしまいます。
これは変数jが定数3から始まっている為です
変数ｊを月集計シートの最終行の下、新規行番号を取得するようにすれば良いです
変数宣言をするならしっかりと書きましょう
例

'抽出
Dim i As Long, j As Long
Dim x As Long

i = 5
j = Application.Max(Worksheets("月集計").Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

月集計シートの１列目を対象に最終行番号+1で新規行番号
End(xlUp).Row + 1で3より小さい行番号が取得された場合　
Max関数でスタート行ナンバー３を代入しています

＞また【1日】から【31日】までのシートを連続で抽出貼り付けが出来るVBAも教えていただけると嬉しいです。

表組を見ると単純な疑問が出てきますが、単純にA・B列の条件に合致する
1～13列内のセルデータを　ブック内の1日～31日シートで繰り返すならば

（条件が出そろっていないので）合理的ではないかも知れませんが
シート全部に対して条件を設けて実行すればよいですね

簡単に書き加えると
Sub 抽出3()

'抽出
Dim i As Long, j As Long
Dim x As Long, n As Long
Dim sh As Worksheet
Dim flag As Boolean

For Each sh In Worksheets
flag = False
For n = 1 To 31
If StrConv(sh.Name, vbNarrow) = StrConv(n & "日", vbNarrow) Then
flag = True
Exit For
End If
Next

If flag Then
i = 5
j = Application.Max(Worksheets("月集計").Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

With sh

Do While .Cells(i, "B").Value <> ""

If .Cells(i, "A").Value <> "" Then

For x = 1 To 13

Worksheets("月集計").Cells(j, x).Value = .Cells(i, x + 1).Value

Next x

j = j + 1

End If

i = i + 1

Loop

End With

End If
Next sh

End Sub

ブックや表組、VBA実行トリガ、データの扱いなどを見直した方が良さそうですが・・・

不明点です。

１．左側の画像が月集計で、右側の画像が日報シート（1日、2日、・・・）でしょうか。
画像が不鮮明なので、状況がよくわかりません。
画像を別々にして、アップすると、多少は鮮明になります。
別々にアップしていただけませんでしょうか。（特に日報シートのほうを優先でお願いします）
尚、画像が不鮮明なのは、あなたのせいではありません。
このサイトに、大きい画像をアップすると、このサイトに仕様で不鮮明になってしまいます。


２．右側が日報シートの前提ですが、提示されたマクロをみると、
設置1のデータしか転記してないように見えます。
設置2、設置3は転記しなくて良いのでしょうか。
（書かれている字が読めないので、○○1、○○2、○○3の○○を設置と書いています）

３．１日のデータを転記する場合は、提示されたマクロになりますが、
２日以降は、どうされるつもりなのでしょうか。
With Worksheets("1日")の "1日"を毎回、"2日"とか"3日"とかに変えて、実行されるつもりでしょうか。

４．１日～３１日までのシートを連続で抽出貼り付けが出来るマクロも作成したいとのことですが、
今年の２月分なら、１日～２８日までになります。
２月分を処理するばあいでも、１日～３１日のシートを処理して良いのでしょうか。
その場合は、２９日以降のシートのデータ行は空にしておく必要があります。
もし、今年の２月分は、１日～２８日までにしたいということであれば、
処理対象となる年月（例２０２５年２月）の情報がどこかにないと、そのような処理ができなくなります。

５．日報シートのA列とB列の具体的な内容がわかりませんが、
１つの行で、考えられるデータの有無のケースは、
①A列がデータ有り、B列がデータ有りのケース
②A列がデータ有り、B列がデータ無しのケース
③A列がデータ無し、B列がデータ有りのケース
④A列がデータ無し、B列がデータ無しのケース

が考えられます。②③のケースもあるのでしょうか。
もし、ある場合は、転記対象になるのでしょうか、ならないのでしょうか。