複数選択したセルを含む行をまとめてコピー

質問

VBA初心者です。EXCEL2003を使用しています。

◆やりたい事
　ユーザーにセルを指定させ、そのセルを含む行をまとめてコピーして新規のブックに貼り付けたい。

◆条件
　・ユーザーが指定できるセルはB列だけにしたい。
　　(B列以外を選択したらメッセージを表示して再選択させる)
　・ユーザーが指定できるセルは(連続・不連続問わず)最大8個までにしたい。
　　(未選択 or 8個以上ならメッセージを表示して再選択させる）

◆完成イメージ
　・ユーザーがセル（ex.B4,B6:B8,B20(=計5行)）を選択
　・マクロ実行(コマンドボタンを押す)
　・新規ブックのsheet1.range("A1")に貼り付け(=A1：A5に 貼り付く）

こんな感じなんですが、なにとぞ御教授願います。

回答No.2

MSZ006 · ベストアンサー

こんな感じでどうでしょうか。
------------------------

Sub test()
Dim Rng As Range

If Selection.Count > 8 Then
MsgBox "9個以上！"
Exit Sub
End If

For Each Rng In Selection
If Rng.Column <> 2 Then
MsgBox "Ｂ列以外！"
Exit Sub
End If
Next

Selection.EntireRow.Select
Selection.Copy

Workbooks.Add
ActiveWorkbook.Worksheets("sheet1").Range("A1").PasteSpecial

End Sub

お礼

回答ありがとうございます！
EntireRow、勉強になりました。ありがとうございました。

回答No.1

noname#184106

こんばんわ。
こんな感じでしょうか。
Sub test()
Dim Obj As Object
Dim Ct As Integer
For Each Obj In Selection
If Obj.Column <> 2 Then
MsgBox "B列を選んでください"
End
End If
If Ct > 8 Then
MsgBox "セルの数は8個以内です。"
End
End If
Ct = Ct + 1
Next Obj
If Ct = 0 Then
MsgBox "セルを選んでください。"
End
End If
Selection.Copy
Workbooks.Add
Range("A1").Select
ActiveSheet.Paste
End Sub

お礼

回答ありがとうございます！
選択したセルを含む行全体をコピーしたいのですがどうしたら良いのでしょう？

補足

◆完成イメージの書き方が間違ってました。

誤)新規ブックのsheet1.range("A1")に貼り付け(=A1：A5に 貼り付く）

正)新規ブックのsheet1.range("A1")に貼り付け(=1～5行に 貼り付く）