エクセル マクロ：チェックボックス コピー

質問

教えてください。

sheet1にデータがあり
sheet2にチェックボックスとコマンドボタンがあります。
チェックボックスにレ点を入れ、コマンドボタンを押すと
sheet1の該当する列をコピーして、sheet3に貼り付ける
マクロを作ろうと思ってますがうまくいきません。
下記のマクロを使えるように手直ししていただけないでしょうか。
よろしくお願い致します。

Private Sub CommandButton1_Click()

Dim myrange As String
Dim rmax As Long
rmax = Sheets("sheet1").Range("A2").End(xlDown).Row
With Sheets("sheet2")
If .CheckBox1 Then myrange = myrange & ",$B$1:$B$" & rmax
If .CheckBox2 Then myrange = myrange & ",$C$1:$C$" & rmax
If .CheckBox3 Then myrange = myrange & ",$D$1:$D$" & rmax
End With
If myrange = "" Then
MsgBox "チェックしてください"
Exit Sub
End If
myrange = "$A$2:$A$" & rmax & myrange
Sheets("sheet1").Range(myrange).Copy
Sheets("sheet3").Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("sheet3").Select

End Sub

回答No.1

keithin · ベストアンサー

１行目からコピーしたいのか２行目からでいいのか，ご質問のマクロには不整合があります。

private sub CommandButton1_Click()
　dim s as string
　dim rmax as long
　rmax = worksheets("Sheet1").range("A65536").end(xlup).row
　if rmax < 2 then exit sub

　s = s & iif(checkbox1.value, ",$B$2:$B$" & rmax, "")
　s = s & iif(checkbox2.value, ",$C$2:$C$" & rmax, "")
　s = s & iif(checkbox3.value, ",$D$2:$D$" & rmax, "")
　if s = "" then
　　msgbox "NO CHECK"
　　exit sub
　end if

　s = "$A$2:$A" & rmax & s
　worksheets("Sheet1").range(s).copy
　worksheets("Sheet3").range("A1").pastespecial, paste:=xlpastevalues
　application.cutcopymode = false
　worksheets("Sheet3").select
end sub

お礼

ご回答ありがとうございました。
sheet1のA1が空欄だったので…
お恥ずかしい限りです。

今後ともご指導よろしくお願いします。