VBA データが増えた分だけコピーし、対象シートに貼り付けたい

Question

■実現したいことは以下になります。
・画像③のデータが増えた分だけ画像2に貼り付けたい(動的に)。
但し、複数シートありで対象の列のみコピーし貼り付けたい。

■現状
・予め、余分に行を増やしたコードで記述をしました。
これだと、コピーしたときにシートとシートの間に空白分も貼り付いてしまう。
対象の列に関しては、無理やり対象の列をコピーしたコードを記述しました。

■分からないこと
・ボタン実行後、どうやって動的に対象の行および列をコピーしているか分からないです。

画像が以下になります。

画像1 情報一覧ボタン.xlsmの画像 [ボタン]シート
手順②を実行後、[各シート一覧情報]シートに①のファイル情報を貼り付けます。

画像2 情報一覧ボタン.xlsmの画像 [各シート一覧情報]シート
貼り付けた結果画面です。この空白部分を取り除いた状態で表示がしたい。

画像③ データ情報一覧.xls
このファイルが読込み一覧データです。

コードが以下になります。

Private Sub SheetPasteButton_Click()
'-------------------------------------------------------------------------------
'   SheetPasteButton_Click
'   説明
'       各シート情報貼り付け クリック時
'-------------------------------------------------------------------------------
    Dim wbk As Workbook             '各シート一覧表ファイル
    Dim wshCmp As Worksheet     　　'シートコピーファイル：[ボタン]シート
    Dim wshOrd As Worksheet       　'シートコピーファイル：[各シート一覧情報]シート
    
    Set wshCmp = Worksheets("ボタン")
    Set wshOrd = Worksheets("各シート一覧情報")
    
    Set wbk = Workbooks.Open(wshCmp.Range("B3").Value, ReadOnly:=True) '読み取り専用で開く
    
    wbk.Worksheets("1_情報一覧").Range("A4:H18").Copy wshOrd.Range("A2")
    wbk.Worksheets("1_情報一覧").Range("K4:K18").Copy wshOrd.Range("I2")
    
    wbk.Worksheets("2_情報一覧").Range("A4:H18").Copy wshOrd.Range("A17")
    wbk.Worksheets("2_情報一覧").Range("K4:K18").Copy wshOrd.Range("I17")

    wbk.Worksheets("3_情報一覧").Range("A4:H18").Copy wshOrd.Range("A32")
    wbk.Worksheets("3_情報一覧").Range("K4:K18").Copy wshOrd.Range("I32")

    '----- ブックを保存しないで閉じ、オブジェクトwbkの参照を解除
    wbk.Close SaveChanges:=False: Set wbk = Nothing

End Sub

よろしくお願いいたします。

Comments

[kuma_kuma_]

なんかどっかで見たなと思ったら、私のコートの書き方だ！
で質問者様はこのコードを作られた方ではないの？
作られた方に聞いた方が早いと思うけど．．．
(基本的な命令2種類しかないから)
前回の回答丸投げがいけなかったかな．．．

>　画像③のデータが増えた分だけ画像2に貼り付けたい(動的に)。
なにを持って「増えた分」か判断材料がないです。
あと前回の内容を把握してるからですが、これ条件が別にもありますよね？
この情報だけで回答すると実際にはうまく連動して動きませんよ？

[qqkf]

コメントありがとうございます。
前回、回答して頂いたコードはVBA側で処理が多かったため、
今回は、前回ベストアンサーにしましたkitasue様のコードを参考にして質問をしました。
kuma_kuma_様から回答して頂いたコードは少しずつですが理解していきたいと考えております。

質問ですが、予め行を多めに入れた設定でコードを書きました。
理由は、画像3各シートのデータが15個まで設定した場合、データを入れるためです。
ただこれだと、15個データが入らない限り空白のまま画像2に貼り付いてしまいます。
なのかつ、拡張したい場合になったとき(例えばデータが30個になったとき)
各シートで行の設定値を変えないといけないです。
今回は、どうやって空白部分を除いた状態でデータを増やして貼り付けていくのか質問しました。
前回、質問ときに増減の件ついてやり取りしたと思いますが、まだそちらのコードでは勉強中です。

[kuma_kuma_]

あの前回回答した処理ではシートに6行以上定義されてもシート自体が4つになってもそのまま動きますよ？
(前回の質問者様の仕様があいまいだった為回答時点でそのように対応しております）
ちなみにデータが15個以上というのはどのデータですか
サンプル数でもA～Gの7サンプルですし

[qqkf]

画像3を差し替えました。
15個のデータと言うのは各情報一覧(画像3)の赤枠で囲まれた部分のことになります。

[kuma_kuma_]

TEST1列TEST2列はさすがに想定できていないので修正が必要だけど
べつに15行だろうが30行だろうが動く設計にしてあるよ？
使わないのも質問者様の判断だから構いませんが...

[qqkf]

N行でコーディングしてる部分ありましたので、参考にしたいと思います。
コメントありがとうございました。

Answer 1

次のコードでいかがでしょうか。

Private Sub SheetPasteButton_Click()
'-------------------------------------------------------------------------------
'   SheetPasteButton_Click
'   説明
'       各シート情報貼り付け クリック時
'-------------------------------------------------------------------------------
    Dim wbk As Workbook             '各シート一覧表ファイル
    Dim wshCmp As Worksheet         'シートコピーファイル：[ボタン]シート
    Dim wshOrd As Worksheet         'シートコピーファイル：[各シート一覧情報]シート
    Dim lngSheetNum As Long
    Dim lngRowsCount As Long
    
    Set wshCmp = Worksheets("ボタン")
    Set wshOrd = Worksheets("各シート一覧情報")

    Set wbk = Workbooks.Open(wshCmp.Range("B3").Value, ReadOnly:=True) '読み取り専用で開く
    
    wshOrd.Range("A2").CurrentRegion.ClearContents
    
    For lngSheetNum = 1 To 3
        With wbk.Worksheets(lngSheetNum & "_情報一覧").Range("A4").CurrentRegion
            .Offset(1).Resize(.Rows.Count - 1, 8).Copy wshOrd.Range("A2").Offset(lngRowsCount)
            .Offset(1, 10).Resize(.Rows.Count - 1, 1).Copy wshOrd.Range("I2").Offset(lngRowsCount)
            lngRowsCount = lngRowsCount + .Rows.Count - 1
        End With
    Next lngSheetNum
    
    '----- ブックを保存しないで閉じ、オブジェクトwbkの参照を解除
    wbk.Close SaveChanges:=False: Set wbk = Nothing

End Sub

Comments

[qqkf]

コーディングありがとうございます。
空白部分を除き、各シートにn行分データが追加することができました。
無事に実現したいことができました。

[syousuke.33]

Kuma_kuma_様の回答　初心者の私にも勉強になりました。
（lngSheetNum & "_情報一覧）これだと「情報一覧」のシートの並びが
順番に並んでいないと、コピーされないシートが発生するような気がします
質問者様のわからないことに　もうひとつ
■分からないこと
・ボタン実行後、どうやって動的に対象の行および列をコピーしているか分からないです。
私の場合、マクロ組時、よくコピペします　そしてSelectもよく使います
モニター画面を右半分シート、左半分にモジュール画面表示させて
[Ｆ８]キーを押しながら　セルの動きを確認しながら組んでいます
私がこの質問者の回答したら構文の長さは、2,5倍の長さになってしまいます。私も勉強になりました。