検索で探したセルをコピーしてはりつける

質問

例えば、Win2000とかWinXPなどOSの種類が各セルに入っていて検索で*2000として、検索で見つかったセルをすべてコピーして隣のセルにはりつけるというマクロを作りたいのですが、マクロの記録でしてもセル番地を記憶していろんなパターンに対応できません。
よろしくお願いします。

回答No.5

papayuka · ベストアンサー

シート名が合計シートのA列にA2から順に貼り付けます。

Sub myFind()
Dim s As String, fAddr As String, f
Dim r As Range, ws As Worksheet

　Set ws = Worksheets("合計シート")
　If ActiveSheet Is ws Then Exit Sub

　s = Application.InputBox("検索値？", "my検索", Type:=2)
　With ActiveSheet.Columns(ActiveCell.Column)
　　Set f = .Find(s, LookIn:=xlValues, LookAt:=xlWhole)
　　If Not f Is Nothing Then
　　　 fAddr = f.Address
　　　 Do
'　　　　　f.Offset(0, 1).Value = f.Value
　　　　　ws.Range("A65536").End(xlUp).Offset(1, 0).Value = f.Value
　　　　　Set f = .FindNext(f)
　　　 Loop While Not f Is Nothing And f.Address <> fAddr
　　End If
　End With
End Sub

お礼

(*^_^*)ものすごく感激です。やりたいことがいっきにできました。本当にありがとうございます。
助かりました。

回答No.4

papayuka

> これをシートを指定して（合計シート）貼り付け可能ですか？
> できれば、空白がないとよいのですがm(__)m

意味が解りません。
元の質問から変わってる？

> あと、Type2とはどういう意味があるので　しょうか？

返されるデータ型を文字列（テキスト）としてます。（この場合は省略しても良い）
詳しくはExcelVBAヘルプの InputBoxメソッドを確認してください。

お礼

すいません。隣のセルではなく隣のシートの書き間違いです。で、教えていただいたものを実行すると、該当セルの隣に張り付くので該当なしのセルは空白になりますよね。それをつめて貼り付けしたいのです。
Win2000Win2000
WinXP
Win2000Win2000
となるのを、
Win2000
Win2000としたいのです。インプットボックスで調べるのですかm(__)mタイプで調べた物ですいません。
わかりました。

回答No.3

shkwta

ワイルドカードを使って前方一致で検索する、という条件で作ってみました。
検索したいセル範囲を選択してからマクロを実行し、インプットボックスに検索文字列(*2000など）を入れてください。

Sub SearchCopy()
　　Dim ce As Range
　　Dim sc As Integer
　　Dim st As String

　　On Error Resume Next

　　st = InputBox("検索文字列", "検索してコピー")
　　For Each ce In Selection
　　　　sc = 0
　　　　sc = WorksheetFunction.Search(st, ce.Value)
　　　　If sc = 1 Then ce.Offset(0, 1) = ce
　　Next
End Sub

回答No.2

papayuka

検索したいデータがある列の何処かのセルを選択して実行

Sub myFind()
Dim s As String, fAddr As String, f
　s = Application.InputBox("検索値？", "my検索", Type:=2)
　With ActiveSheet.Columns(ActiveCell.Column)
　　Set f = .Find(s, LookIn:=xlValues, LookAt:=xlWhole)
　　If Not f Is Nothing Then
　　　 fAddr = f.Address
　　　 Do
　　　　　f.Offset(0, 1).Value = f.Value
　　　　　Set f = .FindNext(f)
　　　 Loop While Not f Is Nothing And f.Address <> fAddr
　　End If
　End With
End Sub

お礼

ありがとうございます。なんかすごいコードですね(^^♪　f.Offset(0, 1).Value = f.Valueこのコードで1つ隣のセルに貼り付けされているようですが、これをシートを指定して（合計シート）貼り付け可能ですか？
できれば、空白がないとよいのですがm(__)m　あと、Type2とはどういう意味があるので　しょうか？

回答No.1

shkwta

単に、数式を使って、たとえばA1にOSの名前が入っているならB1に
=IF(ISERR(SEARCH("*2000",A1)),"",A1)
と入れればお望みのものになるのですが、マクロでないとダメですか？

お礼

ありがとうございます。2000だけ貼り付けたいのではなく、いろいろなものを貼り付けたいのとこれから先
よく使うのでマクロでやりたいのです。
条件をいれて、それをコピーして貼り付けたいのです。