【VBA】特定の文字列を含む場合、列ごとコピーし最終列の隣に形式を選択して貼り付ける方法

マクロ初心者です、お世話になります。
添付した資料の様に、1行目に項目があり(200項目くらい)、その下にデータが並んでいます。
この中から、検索に合致した項目がある場合、列ごとコピーし最終列の隣に形式を選択して貼り付けたいです。
項目数は固定されていますが、項目の順番は毎回変わります。
下の様に自分で書いてみたのですが、うまくいきません。

Sub sumple1()

Dim r As Range
For Each r In Range("A1:ALF1")
If r.Value = "項目1" Then r.EntireColumn.Copy
Columns("GB").PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationAdd
Next r

End Sub
上ではコピーまではできますが、貼り付けという行動が失敗しましたというメッセージが出てしまいます。
すごく初歩的な質問かと思いますが、どなたか教えてくださればうれしいです。

No.1 ベストアンサー 回答者： tom04 回答日時： 2018/03/28 14:43

こんにちは！

色々やり方はありますが、一例です。

Sub Sample1()
Dim c As Range
Set c = Rows(1).Find(what:="項目1", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then '//←念のため//
c.EntireColumn.Copy
With Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
.PasteSpecial Paste:=xlPasteValues
.Select
End With
Application.CutCopyMode = False
End If
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

tom04様

ご親切にありがとうございます！
自分で試したところ、複数の項目検索でも、きちんと機能しました(*^▽^*)
本当にありがとうございます！

また機会があれば、よろしくお願いいたします（o_ _)ｏ））

お礼日時：2018/03/28 21:29