最終列に飛ばずに、上書きになってしまいます。

投稿者 : たか     投稿日時 : 2024/07/18(Thu) 12:53:59     OS : 未指定     EXCEL : 未指定

---

Sub 登録()

    Dim targetWs As Worksheet
    Dim r As Long
    
    Set targetWs = Worksheets("2024")
    r = targetWs.UsedRange.Rows.Count + 1
    
    Worksheets("入力").Range(Cells(4, 4), Cells(6, 4)).Copy
    targetWs.Cells(r, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = r - 3
    
    Worksheets("入力").Range(Cells(11, 4), Cells(13, 4)).Copy
    targetWs.Cells(r, 5).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = 8 - 3
    
     Worksheets("入力").Range(Cells(14, 4), Cells(16, 4)).Copy
    targetWs.Cells(r, 8).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = r - 3
    
     Worksheets("入力").Range(Cells(17, 4), Cells(19, 4)).Copy
    targetWs.Cells(r, 11).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = r - 3
    
    
    Application.CutCopyMode = False
    
    MsgBox "登録が完了しました。"

End Sub

入力したものを、別シートへ飛ばしたいのですが、
毎回一番上のデータが上書きされてしまいます。
以前の入力データは残して、下の列へ入力されるようにしたいです。
マクロの修正箇所を教えてください。

投稿者 : さんこう     投稿日時 : 2024/07/18(Thu) 13:29:09

---

＞以前の入力データは残して、下の列へ入力されるようにしたいです。

「下の列」というのが謎ですが、

「r = targetWs.UsedRange.Rows.Count + 1」が想定と違う値になるからだと思われます。

A1セルになにか記入しておくといいでしょう。

投稿者 : ピロリ     投稿日時 : 2024/07/18(Thu) 18:33:48

---

多分「2024」シートの上の方に、空行が存在しているのでは？（既にご指摘が有りますが。）
下のような感じではどうでしょう？　気になるところもコメントしておきましたけど。

また、ステップ実行して意図した値が得られたか、デバッグの方法も覚えた方が良いと思います。
VBAを扱う以上、避けては通れませんので・・・
<https://www.239-programing.com/excel-vba/basic/basic021.html>

Sub 登録()
    
    Dim targetWs As Worksheet
    Dim r As Long
    
    Set targetWs = Worksheets("2024")
    'r = targetWs.UsedRange.Rows.Count + 1                      '↓こういうことがしたいのかな？
    r = targetWs.UsedRange.Rows(targetWs.UsedRange.Rows.Count).Row + 1
    
    'Worksheets("入力").Range(Cells(4, 4), Cells(6, 4)).Copy    '↓正しくはこんな感じですかね。
    Worksheets("入力").Range(Worksheets("入力").Cells(4, 4), Worksheets("入力").Cells(6, 4)).Copy
    targetWs.Cells(r, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = r - 3                  '←これは何をしたいのか分かりませんけど。
    
    'Worksheets("入力").Range(Cells(11, 4), Cells(13, 4)).Copy  '↓正しくはこんな感じですかね。
    Worksheets("入力").Range(Worksheets("入力").Cells(11, 4), Worksheets("入力").Cells(13, 4)).Copy
    targetWs.Cells(r, 5).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = 8 - 3                  '←これは何をしたいのか分かりませんけど。
    
    'Worksheets("入力").Range(Cells(14, 4), Cells(16, 4)).Copy  '↓正しくはこんな感じですかね。
    Worksheets("入力").Range(Worksheets("入力").Cells(14, 4), Worksheets("入力").Cells(16, 4)).Copy
    targetWs.Cells(r, 8).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = r - 3                  '←これは何をしたいのか分かりませんけど。
    
    'Worksheets("入力").Range(Cells(17, 4), Cells(19, 4)).Copy  '↓正しくはこんな感じですかね。
    Worksheets("入力").Range(Worksheets("入力").Cells(17, 4), Worksheets("入力").Cells(19, 4)).Copy
    targetWs.Cells(r, 11).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    targetWs.Cells(r, 1).Value = r - 3                  '←これは何をしたいのか分かりませんけど。
    
    Application.CutCopyMode = False
    
    MsgBox "登録が完了しました。"
    
End Sub

投稿者 : がっかり     投稿日時 : 2024/07/18(Thu) 21:12:51

---

さんこうさんの言っていることはこういう事なんだが
にしても解凍側が解ってないとは

新規シートでお試しください

Sheets("Sheet1").Range("D10:J20").Value = 1
Sheets("Sheet1").UsedRange.Rows.Select
MsgBox Sheets("Sheet1").UsedRange.Rows.Count

投稿者 : てらてら     投稿日時 : 2024/07/19(Fri) 06:05:47

---

こんにちは。
適当に想像してみました。

Sub 登録()

    Dim targetWs As Worksheet
    Dim r As Long
    
    Set targetWs = Worksheets("2024")
    r = targetWs.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If r < 4 Then r = 4
    
    targetWs.Cells(r, 1).Value = r - 3

    Worksheets("入力").Range("D" & 4 & ":D" & 6).Copy
    targetWs.Cells(r, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
    Worksheets("入力").Range("D" & 11 & ":D" & 13).Copy
    targetWs.Cells(r, 5).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
    Worksheets("入力").Range("D" & 14 & ":D" & 16).Copy
    targetWs.Cells(r, 8).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
    Worksheets("入力").Range("D" & 17 & ":D" & 19).Copy
    targetWs.Cells(r, 11).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
    
    Application.CutCopyMode = False
    
    MsgBox "登録が完了しました。"

End Sub

投稿者 : anonymous     投稿日時 : 2024/07/19(Fri) 11:08:31

---

■[返信 3] がっかりさん（2024-07-18 21:12:51）の記事
＞ さんこうさんの言っていることはこういう事なんだが
＞ にしても解凍側が解ってないとは
＞
＞ 新規シートでお試しください
＞
＞ Sheets("Sheet1").Range("D10:J20").Value = 1
＞ Sheets("Sheet1").UsedRange.Rows.Select
＞ MsgBox Sheets("Sheet1").UsedRange.Rows.Count

あなたこそ理解されていないと思います。

Sub test()
    With Sheets("Sheet1")
        .Range("D10:J20").Value = 1
        MsgBox .UsedRange.Rows(.UsedRange.Rows.Count).Row + 1
    End With
End Sub

こういう提案をピロリさんはされているんですけどねえ。よく読んで下さい。

投稿者 : ピロリ     投稿日時 : 2024/07/19(Fri) 19:37:53

---

■[返信 3] がっかりさん（2024-07-18 21:12:51）の記事、見逃してました。平日の日中は見てないので。
記事にある、さんこうさんの仰っていることは理解しているつもりですよ。その上での一案です。

anonymousさん、解説ありがとうございました。　テストコードまで作成していただいて...


この手の入力データの最終行取得に当たっては、必ずデータが入力される A列に対し、てらてらさん案の
ように Range.End(xlUp) するか、ループで空白セルを探すかが、王道でしょう。
最終行取得に UsedRange は扱い辛いので（後で述べますが）、邪道の類なのかも知れませんね。
今回は質問者さんのコード（考え方）を変えない方向での提案でしたが、私も Range.End(xlUp) 派です。

データ入力が無くても、罫線などセルの書式設定した時点で、そのセルは UsedRange に取り込まれます。
あらかじめ罫線を引いた表を作成してしまうと、 UsedRange.Rows(UsedRange.Rows.Count).Row + 1 は、
常に表の下（欄外）になってしまいます。この辺りは扱い辛いですね。要注意です。
そういった点では、てらてらさんの案がベストかも。