エクセルで最下行にデータを追加するVBA

エクセルで同じ書式の3枚のシートを「集計」シートに統合したいのですが、マクロの記録で作成したコードを試行錯誤して最終行に追加は出来るのですが、最終行の1つ下の行が取得できません。
最後の行が上書きされて各シートの最終行が抜けてしまいます。

Range(Selection, Selection.End(xlDown)).Select
に .Offset(１)を追加すれば出来る事は分かっているのですがどうにもうまくいかずHELPお願いします。

具体的には、3枚のシートの6行目以降最後の行までをコピーして「統合」シートの6行目以降に3枚のシートを統合したいのです。

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

• 失礼しました。
  シート数はBookによって確定ではないので、試しにシート数を2枚のデモシートで試していましたが、シートを3枚にしたら期待通りに動きました。
  
  追加の質問になって申し訳ありませんがシートが変わった場合、どこを変更すれば良いのでしょう？
  当方はシート毎にVBAを繰り返すものと思っていたので、必要回数のコードで追加、削除するつもりの質問でした。

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/05/09 11:10

No.6 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/05/09 11:45

すみません。

"結果3"　と "結果4"　シートの比較だけでなく、
"結果３" と "結果1"　シートの比較
"結果３" と "結果2"　シートの比較
も行っていただけますでしょうか。

この回答へのお礼

誠に申し訳あり有りません。

結果4のシートは慌てて結果3のシートのコピのまま試行しましたので、結果３が2回ではなくちゃんと結果4がコピペされていました。

本当に申し訳なく、恥ずかしく・・・

最後まで本当にお手数をお掛けしありがとうございました。
自分でもおかしいと思い、昼休みに色々試行していて気づきました。

お輪にしようとしたら、既にご返答がついていました。

お礼日時：2023/05/09 12:47

No.5 回答者： tatsumaru77 回答日時： 2023/05/09 11:40

＞arr = Array("結果1", "結果2", "結果3", "結果4")

の３枚目が２回コピーとは、
"結果3"が２回コピーされたようにみえたことかと思いますが、

"結果4"の６行目以降の内容が、"結果3"と同じ内容だったということはないでしょうか。

"結果3"の６行目以降と"結果4"の６行目以降は、必ず、異なる内容でしょうか。

この回答へのお礼

ご推察の通りでした。
お恥ずかしい限りで申し訳ない。

お礼日時：2023/05/09 16:06

No.4 回答者： tatsumaru77 回答日時： 2023/05/09 11:28

>2枚の場合はうまくいったのですが、4枚にすると3枚目のシートが2回コピペされてしまいます。

４枚のシート名は全て異なるシート名でないといけません。
arr = Array("○○", "△△","□□","□□")　のように
３枚目と４枚目が同じ名前になっていませんでしょうか。

あなたが設定した、arr = Array(・・・)　の行を
提示していただけませんでしょうか。

この回答へのお礼

ありがとうございます。
シート名は下記の通りです。

>arr = Array("結果1", "結果2", "結果3", "結果4")

表示がおかしくなるようなのでシート名のみ下記します。
結果1、結果2、結果3、結果4
です。

お礼日時：2023/05/09 11:33

No.3 回答者： tatsumaru77 回答日時： 2023/05/09 11:16

>追加の質問になって申し訳ありませんがシートが変わった場合、どこを変更>すれば良いのでしょう？

シートが２枚の場合、シート名：○○　と　シート名：△△　をコピーしたなら
arr = Array("○○", "△△")　のようにします。

シートが４枚の場合、
シート名：○○　と　シート名：△△　シート名：□□　と　シート名：☆☆　をコピーしたいなら

arr = Array("○○", "△△","□□","☆☆")　のようにします。

この回答へのお礼

何度もすみません。

2枚の場合はうまくいったのですが、4枚にすると3枚目のシートが2回コピペされてしまいます。

申し訳ありませんがもう一息だと思うので何卒宜しくお願い致します。

お礼日時：2023/05/09 11:23

No.2 回答者： tatsumaru77 回答日時： 2023/05/09 11:10

>シート名を変えて早速試してみたのですが、

＞Set ws = Worksheets(sname)
>で止まってしまいます。

シート名を正しく設定していない可能性があります。
本当に実在するシート名か、再度確認してください。
arr = Array("Sheet1", "Sheet2", "Sheet3")
の箇所のシート名をあなたの環境に合わせます。

No.1 回答者： tatsumaru77 回答日時： 2023/05/09 10:52

3枚のシート名が不明なので、Sheet1,Sheet2,Sheet3としておきました。

シート名：統合　に集計します。
いかのようにしてください。
３つの各シートの最終行はA列を基準にして最終行を求めています。

Public Sub 統合へ集計()
Dim arr As Variant
Dim sname As Variant
Dim ws As Worksheet
Dim ms As Worksheet
Dim mrow As Long: mrow = 6
Set ms = Worksheets("統合")
ms.Rows("6:" & Rows.Count).ClearContents
arr = Array("Sheet1", "Sheet2", "Sheet3")
For Each sname In arr
Set ws = Worksheets(sname)
Call shukei(ws, ms, mrow)
Next
End Sub
Private Sub shukei(ws As Worksheet, ms As Worksheet, mrow As Long)
Dim maxrow As Long
Dim wrow As Long
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'A列目の最終行を求める
For wrow = 6 To maxrow
ws.Rows(wrow).Copy ms.Rows(mrow)
mrow = mrow + 1
Next
End Sub

この回答へのお礼

早々のご回答ありがとうございます。

シート名を変えて早速試してみたのですが、
＞Set ws = Worksheets(sname)
で止まってしまいます。

何処か他に注意すべき箇所あれば教えて頂きたく。

お礼日時：2023/05/09 11:03