エクセルVBA オートシェイプのコピペ、セル結合、シート再コピー必要時の認識がうまくできない。

Question

エクセルVBA初心者です。いままでマクロに全く触れたことがありませんでしたが業務で繰り返し作業を無くすために取り組み始めました。しかし始めて3ヵ月になりますが以下の問題が解決できずに困っております。何卒ご指導いただけないでしょうか。

やりたいこと。
原本シートと雛形シートがあります。原本シートの該当する商品にチェックをしてマクロを実行すると、選択した商品リストが最終シートにコピーされる、というものです。
複製されたリストの最終行C17に商品が記入されていると新たに雛形を最終シートにコピーして商品の登録を続けます。

今、うまく解決できなくて困っていることは以下になります。

1, リスト中のオートシェイプもコピーしたいがうまくコピーできない。

2, 商品No.7と9の時は、セル結合の行を2倍にしたい(4行分の結合にしたい)

3, No.7と9の4行結合がC15～18に来ると,C17での入力が認識されずに雛形がコピーされない。また後続の商品リストに上書きされてしまう。

原本シートをはじめから結合してあるのはオートシェイプも一緒にcopyメソッドでコピーしたいと思ったからです。
ですが時には原本シートで選択しない項目もあるので For文で空白リストの上から空白セルを探して貼り付けしていきますので .copy destinationでうまくできませんでした。
上から順番に詰めて転写したいことと、copy.destinationでオートシェイプも含めて転写することの両立が解決できません。
今はPasteSpecial xlPasteAllでやろうとしていますがこれではやっぱりオートシェイプはコピーできないでしょうか？

どうかご指導をよろしくお願いいたします。

Sub 商品リスト転記()

Dim cb As CheckBox
Dim St1 As Worksheet
Dim i As Long
Dim j As Long
Dim k As Long

  Set St1 = Sheets("原本")
  i = 3
  j = 4
  
  
'雛形シートをコピーして最終に
        Sheets("雛形").Copy After:=Sheets(Sheets.Count)

'チェックボックスをループ
　　　For Each cb In St1.CheckBoxes
    
        St1.Select

'チェックボックスがオンなら
        If cb.Value = xlOn Then
        
'チェックボックスがオンの商品を、別シートへコピペする
        Range(Cells(i, 2), Cells(j, 20)).Copy
        Sheets(Sheets.Count).Select
        
        For k = 3 To Sheets(Sheets.Count).Range("C1000").End(xlUp).Row + 2 Step 2
        If Sheets(Sheets.Count).Range("C" & k).Value = "" Then
        Range(Cells(k, 2), Cells(k, 20)).PasteSpecial xlPasteAll

’商品N0,7と9の場合、セル結合を4行分に増やす。        
        If k = 15 Or k = 19 Then
        Range(Cells(k, 2), Cells(k, 20)).UnMerge
        Sheets(Sheets.Count).Cells(k, 2).Resize(4, 1).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 3).Resize(4, 5).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 8).Resize(4, 2).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 10).Resize(4, 3).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 13).Resize(4, 1).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 14).Resize(4, 2).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 16).Resize(4, 2).MergeCells = True
        Sheets(Sheets.Count).Cells(k, 18).Resize(4, 3).MergeCells = True
        End If
        
        If Sheets(Sheets.Count).Range("C17") <> "" Then
        Sheets("雛形").Copy After:=Sheets(Sheets.Count)
        End If
        
        End If
        
        Next
        
        St1.Select
                
        End If
        
        i = i + 2
        j = j + 2
        
Next cb

End Sub

Answer 1

やりたいことを正確に読み取れてないかもしれませんが、
こんな感じでどうでしょうか。

Sub 商品リスト転記()

Dim cb As CheckBox
Dim St1 As Worksheet
Dim St2 As Worksheet
Dim i As Long
Dim k As Long

  Set St1 = Sheets("原本")
  i = 3
  
'雛形シートをコピーして最終に
        Sheets("雛形").Copy After:=Sheets(Sheets.Count)

'コピー先
        Set St2 = Sheets(Sheets.Count)
        k = 3

'チェックボックスをループ
      For Each cb In St1.CheckBoxes
    
'チェックボックスがオンなら
        If cb.Value = xlOn Then
        
'チェックボックスがオンの商品を、別シートへコピペする
        Dim c As Range
        Set c = St1.Cells(i, 2).Resize(2, 19)
        
        
'商品N0,7と9の場合、セル結合を4行分に増やす。
        Dim r As Long
        If i = 15 Or i = 19 Then
            r = 4
        Else
            r = 2
        End If
        
'ページ替え
        If k + r > 17 Then
            Sheets("雛形").Copy After:=Sheets(Sheets.Count)
            Set St2 = Sheets(Sheets.Count)
            k = 3
        End If
            
'チェックボックスがオンの商品を、別シートへコピペする
        c.Copy St2.Cells(k, 2)
        
'セル結合
        St2.Cells(k, 2).Resize(r, 1).Merge
        St2.Cells(k, 3).Resize(r, 5).Merge
        St2.Cells(k, 8).Resize(r, 2).Merge
        St2.Cells(k, 10).Resize(r, 3).Merge
        St2.Cells(k, 13).Resize(r, 1).Merge
        St2.Cells(k, 14).Resize(r, 2).Merge
        St2.Cells(k, 16).Resize(r, 2).Merge
        St2.Cells(k, 18).Resize(r, 3).Merge
       
'コピー先を次の行へ
       k = k + r
        
        End If
        
'コピー元を次の行へ
        i = i + 2
Next cb

End Sub

Comments

[vba_shoshin]

お礼が遅くなり申し訳ございません。
教えていただいたマクロを動かしてみて大変驚きました。3か月もずっと悩んでいたので、すべて完璧に動いたときはうれしいというより驚愕してしまいました。
コピーする行を i の変数で変えて、それ全体をRangeオブジェクトでまとめるなんて、初心者の私には思いもつきませんでした。
また、4行結合、再度のシートコピーのトリガーもとても簡単にされていて驚きとともに、VBAはシンプルに簡単に表現できるけどそこに行きつくのがとても難しいなと痛感いたしました。でもすごく面白いなとも思いました。
他のマクロも作成してみようと思います。今回は大変勉強させていただきました。心よりお礼申し上げます。本当にありがとうございました。