エクセルのマクロについて教えてください。

下記のマクロを実行すると
コピー元の指定した範囲をコピー先のして範囲にコピーできます、
コピー先には、各セルにチェックボックスがあり、下記のマクロでは各セルはコピーできますが、
チェックブックスがコピーできません、
コピー元の各セルとチェックボックス共コピーできる方法を教えてください。
各マクロです。
貼り付け総合
Call 提出シートコピー範囲マクロファイル含む
Call 貼り付け
End Sub

Sub 提出シートコピー範囲マクロファイル含む()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
folderPath = ThisWorkbook.Path & "\"
'作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の
'○〇(提出用).xlsxの 2つ のExcelファイルしかありません｡
fileName = Dir(folderPath & "*.xls?")
Do While fileName <> ""
If CheckName(fileName) = True Then Exit Do
fileName = Dir()
Loop
If fileName <> "" Then
'別ブック ○〇(提出用).xlsx
Set Wb2 = Workbooks.Open(folderPath & fileName)
On Error Resume Next
Set ws = Wb2.Worksheets("提出シート")
If Err.Number <> 0 Then
MsgBox "コピー元ブックの提出シートが見つかりません"
On Error GoTo 0
Wb2.Close False
End
End If
'セルの値を取得する
ws.Range("B1:S220").Copy
Else
MsgBox "コピー元ブックが見つかりません": End
End If
End Sub
Private Function CheckName(ByVal fileName As String) As Boolean
CheckName = False
If fileName = ThisWorkbook.Name Then Exit Function
CheckName = True
If LCase(Right(fileName, 5)) = ".xlsx" Then Exit Function
If LCase(Right(fileName, 5)) = ".xlsm" Then Exit Function
CheckName = False
End Function

Sub 貼り付け()
Dim ws1 As Worksheet
Set Wb1 = Workbooks(1) 'このブック
On Error Resume Next
Set ws1 = Wb1.Worksheets("受付")
If Err.Number <> 0 Then
MsgBox "コピー先ブックの受付シートが見つかりません"
Application.CutCopyMode = False
On Error GoTo 0
If Not Wb2 Is Nothing Then Wb2.Close False
End
End If

Application.DisplayAlerts = False
Application.EnableEvents = False
ws1.Range("B1:S220").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
よろしくお願いいたします。

No.1 ベストアンサー 回答者： fujillin 回答日時： 2025/03/29 13:01

こんにちは

なんだか、やたらややこしいですね。
プロシージャをまたいでコピペするような、妙な構成にする必要がなぜあるのか全くわかりませんけれど・・・

普通にコピペすれば、セル内のオブジェクトもコピーされるはずですので、「値をペースト」にせずに、通常のペーストにすれば良いだけではないでしょうか？
Copyメソッドで引数にペースト先を指定すれば、1センテンスで済みます。

この回答へのお礼

お礼日時：2025/03/29 13:02