| 
    
     |  | 1or8 さん 
 ありがとうございます。
 しかも、簡略化までしていただきまして、
 スッキリしました。
 
 VBA難しいですが、面白いですね。
 感謝します!
 
 
 ▼1or8 さん:
 >▼bon さん:
 >こんばんは。
 >
 >>ちなみに、常に隣に貼り付けるのではなくて、
 >>E列に詰めて貼り付ける事は可能でしょうか?
 >方法は異なりますが、こんなのはどうでしょうか?
 >
 >>Sub kensaku()
 >>
 >>  Dim i As Integer
 >>  Dim cpyname As String
 >   Dim j As Long '追加
 >>
 >>  i = 1
 >   j = 1 '追加
 >>
 >>  Do Until Cells(i, "A").Value = ""
 >>
 >>  If Cells(i, 1).Value = "Word入門" Then
 >    Range(Cells(i, 2), Cells(i, 3)).Copy 'ちょっと簡潔に
 >    Range("E" & j + 1).PasteSpecial 'ちょっと簡潔に
 >    j = j + 1 '追加
 >>  End If
 >>
 >>  i = i + 1
 >>  Loop
 >>
 >>End Sub
 
 
 |  |