| 
    
     |  | 最近度々御世話になり、大変助かっています。 今回の質問は、「シート1」でアクティブセルのある行の指定した(1:100)の範囲を「シート2」の指定した(CM1:CM100)に貼り付けたいのですが。どうしたらいいのでしょうか。
 私なりに下記のように作ってみたのですが、CM列に延々と繰り返し書き込んでしまいます。
 どうかよろしくお願いします。
 
 
 Private Sub CommandButton1_Click()
 
 Dim PrintMenu As Long
 Dim r As Range
 Dim ws1 As Worksheet, ws2 As Worksheet
 Set ws1 = Worksheets("シート1")
 Set ws2 = Worksheets("シート2")
 
 With ws1
 ActiveCell.Activate
 For Each r In Selection
 
 If r.Row > 1 And .Range("A65536").End(xlUp).Row >= r.Row Then
 ws1.Rows(r.Row).Select
 Selection.Copy
 ws2.Select
 Columns("CM:CM").Select         'CM列に貼り付け
 Selection.PasteSpecial :=xlPasteValues,Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=True
 
 End If
 Next r
 End With
 End Sub
 
 |  |