[[20231022151835]]　『VBA 1行を複数行にコピー』（力）　ページの最後に飛ぶ

『VBA 1行を複数行にコピー』（力）

最終行のみを取得して、コピーをし複数行に増やすマクロ行いたいです。
ネットで似た下記コードを見つけました。
しかし、実行すると全ての行数を複数行コピーします。
最終行のみをするには、どのように変更したら宜しいでしょうか。

例:最終行の「う」を１行複数行コピ-行いたい

   Ａ   B  C 
1　あ
2　い
3　う
↓

  Ａ   B  C 
1　あ
2　い
3　う
4　う

ネットで見つけたVBAで行うと↓

  Ａ   B  C 
1　あ
2　あ
3　い
4　い
5　う
6　う

Sub 複数行コピー()

    'A列最終行の取得（LstRow　=　Cells（）の中の1を調整。Bなら2）
    Dim LstRow As Long
    LstRow = Cells(Rows.Count, 1).End(xlUp).Row
   '最終的な行数をInputBoxから取得
    Dim a As Long
    a = Application.InputBox("最終的に何行にしますか？", Type:=1)
   'InputBoxの引数が2より小さ場合、終了する。
    If a < 2 Then
           MsgBox "有効でない数値が入力されました。"
        End
    End If
   'aを増やす行数に変換する。
    a = a - 1

   '繰り返し処理（見出し行ありを「LastRow to 2」で調整、見出しがなければ「to 1」）
    For i = LstRow To 1 Step -1
        Rows(i).Select
        Selection.Copy
        Rows(i + 1 & ":" & i + a).Select
        Selection.Insert Shift:=xlDown
   Next

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 提示のコードは見てないです。
 最終行を一つ下にコピーするだけなら↓とか
 Sub test()
     With Cells(Rows.Count, "A").End(xlUp)
         Cells(.Row, "A").Copy Cells(.Offset(1, 0).Row, "A")
     End With
 End Sub
（フォーキー） 2023/10/22(日) 16:01:31

フォーキー様

ご返信ありがとうございます。
説明不足で申し訳ございません。
掲示したコードは、InputBoxが開いて、要望に応じて行数をふやすことができます。
業務において日々行数が変更になるので、掲示コードを活用し、最終行のみを取得したいです。
宜しくお願いします。

（力） 2023/10/22(日) 16:15:45

やりたいことがいまいち分からないんですが、
最終行の値を、インプットボックスで指定した数だけ最終行の下にコピーしたいってことで合ってます？
（フォーキー） 2023/10/22(日) 16:26:26

フォーキー様

はい、仰る通りです。
宜しくお願いします。
（力） 2023/10/22(日) 16:27:52

最終行を含めるか否かが分からなかったので、必要があれば Resize(a) の部分のaを+1してください。

Sub test2()

    Dim a As Long
    a = Application.InputBox("最終的に何行にしますか？", Type:=1)
    If a < 2 Then
        MsgBox "有効でない数値が入力されました。"
        Exit Sub
    End If
    With Cells(Rows.Count, "A").End(xlUp)
        Cells(.Row, "A").Copy Cells(.Row, "A").Resize(a)
    End With
End Sub
（フォーキー） 2023/10/22(日) 16:35:17

 ほぼ同じですが、せっかく作ったので。
 最終行を指定した行数(最終行も含めて)に増やすという仕様です。

 Sub test3()
    Dim a As Long
    a = Application.InputBox("最終的に何行にしますか？", Type:=1)
    If a < 2 Then
        MsgBox "有効でない数値が入力されました。"
    Else
        With Cells(Rows.Count, "A").End(xlUp)
            .Copy .Resize(a)
        End With
    End If
  End Sub

（hatena） 2023/10/22(日) 16:40:17

フォーキー様、hatena様

どちらも思い通りの結果でした。
活用させて頂きます。
日によって500行以上のコピーをしなくては、ならないので非常に時間短縮になります。
本当にありがとうございます！！

（力） 2023/10/22(日) 16:48:02

 hatenaさんありがとうございます。
 >.Copy .Resize(a)
 でよかったですね
 前もどなたかに指摘受けたんですけど、またやっちゃいましたね。。。
（フォーキー） 2023/10/22(日) 16:51:04

フォーキー様、hatena様
申し訳ございません。
A列だけではなく、B・C・・・と行に入力されている全てをコピーしたいです。
説明不足でお手間をかけて申し訳ございません。
（力） 2023/10/22(日) 16:58:07

列数は決まっているんですか？
（フォーキー） 2023/10/22(日) 17:11:30

フォーキー様

A～ＤＤ列となっております
宜しくお願いします。
（力） 2023/10/22(日) 17:34:50

 hatenaさんのコードをお借りします。
 .Resize(, Columns("DD").Column).Copy の部分は、
 .Resize(, 108).Copy でもOKです。

 Sub test4()
    Dim a As Long
    a = Application.InputBox("最終的に何行にしますか？", Type:=1)
    If a < 2 Then
        MsgBox "有効でない数値が入力されました。"
    Else
        With Cells(Rows.Count, "A").End(xlUp)
            .Resize(, Columns("DD").Column).Copy .Resize(a)
        End With
    End If
  End Sub
（フォーキー） 2023/10/22(日) 17:48:32

フォーキー様

ありがとうございます！！
思い通りです。お手数をお掛け致しましたｍ(--)ｍ
（力） 2023/10/22(日) 17:57:42

コメント返信：

[ 一覧(最新更新順) ]

[[20231022151835]] 『VBA 1行を複数行にコピー』（力） ページの最後に飛ぶ

[[20231022151835]]　『VBA 1行を複数行にコピー』（力）　ページの最後に飛ぶ