エクセルVBA任意の文字で検索しリストUPするには

質問

お世話になります。

恥ずかしながら、VBAはまるっきりの初心者でネットで落ちているものを
かき集めて貼り合せることしかできません。

A列に仕入先名、　B列に品番、　C列に注文数　のデータがあり、
仕入先を指定して、注文数>0、の品番を別シートにコピペするマクロを作っています。
ここで、困っているのが、仕入先を正確に入力しないといけない点です。

特に株式会社の標記です。
株式会社、（株）、(株)、前(株)、後(株)、記号の株　など

そこで、社名の一部だけ入力すれば検索できるようにしたいのですが、
どうしたらよいでしょうか？
ワイルドカード　*　を使えばよいのかと思いましたが、うまくいきません。

都合の良い相談ですが、助けて頂けると幸いです。

Sub test()

Dim name As Range
Dim 仕入先 As String

仕入先 = Application.InputBox("検索仕入先入力")

For Each name In Range("A1:A65536")

' 第1条件　仕入先
If name.Value <> 仕入先 Then
GoTo Continue
End If

' 第2条件　注文数
If name.Offset(0, 2).Value <= 0 Then
GoTo Continue
End If

Dim aValue As String
aValue = name.Offset(0, 1).Value

Dim rngPaste As Range

Set rngPaste = Worksheets("Sheet2").Range("A65536").End(xlUp)
If rngPaste.Value <> "" Then
Set rngPaste = rngPaste.Offset(1)
End If

rngPaste.Value = aValue

Continue:
Next

End Sub

回答No.3

noname#223464 · ベストアンサー

すいません。逆でしたね。

If name.Value <> 仕入先 Then
↓（変更）
if InStr(name,仕入先)<1 Then

お礼

早速の回答ありがとうございます。

期待した通りのことが出来ました。
とても助かりました。

回答No.2

noname#223464

If name.Value <> 仕入先 Then　
↓(変更)
if InStr(name,仕入先)>0 Then

回答No.1

keithin

ヤリタイ事：
１．入力した「検索仕入先」をＡ列から探す
２．かつＣ列にゼロより大きい値が記入されている行を探す
３．まとめてコピー貼り付ける

sub macro1()
　dim myText as string

　mytext = application.inputbox("検索仕入先入力")
　if mytext = "False" then exit sub

　worksheets("正しいデータシート名").select

　range("A:C").autofilter field:=1, criteria1:="*" & mytext & "*"
　range("A:C").autofilter field:=3, criteria1:= ">0"
　activesheet.autofilter.range.offset(1).copy _
　　destination:=worksheets("Sheet2").range("A65536").end(xlup).offset(1)
　activesheet.autofiltermode = false
end sub

お礼

早速ご回答頂きありがとうございます。

最終的に品番だけをコピペしたいのですが
私の知識がないため、全体をコピペを改良できませんでした。