Excel VBAで検索結果を新規ブックにコピー

質問

Excel VBAの質問です。
コンボボックスで選択した文字列とSheet1のＣ列の文字列が一致したら、
その行を新規ブックのSheet1にコピーしたいのですが、うまくできません。
新規ブックは開くのですが、データはコピーされていません。
既存ブックのSheet2にはコピーできるので、たぶん、新規ブックのSheet1へコピーという
命令がうまくかけていないのだと思います。
書籍やネットで調べてもよく分かりませんでした。
大変困っているので、どなたかご教授ください。よろしくお願いします。

元のSheet1は以下のようにデータが入力されています。
例えば、コンボボックスで「めがね」と選択されたら、1，4，5行目のC列と一致するので
それらの行を新規ブックにコピーしたいのです。

A B C D
-----------------------------
1|10 10:00 めがね 保管中
2|11 12:00 衣服　　倉庫
3|12 13:00 自転車　保管中
4|13 11:00 めがね　保管中
5|14 13:00 めがね　倉庫

Private Sub Search_Click()

Dim SearchWord As String
Dim gyou As Long
Dim word As String
Dim LastRow As Long
Dim count As Integer
Dim baseBook As Workbook
Dim newBook As Workbook
Dim baseSheet As Worksheet
Dim newSheet As Worksheet

SearchWord = cmbsSyutokubutu_search.Text

Set baseBook = ThisWorkbook
Set baseSheet = baseB.Worksheets("Sheet1")
baseSheet.Activate

With Worksheets("Sheet1")

count = 0
gyou = 4
LastRow = baseSheet.Cells(Rows.count, 5).End(xlUp).Row
Set newB = Workbooks.Add
Set newS = newBook.Worksheets("Sheet1")

Do While Cells(gyou, 3) <> ""
word = Cells(gyou, 3)
If InStr(word, SearchWord) >= 1 Then
Rows(gyou).Copy newBook.Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
End If
gyou = gyou + 1
Loop

End With
End Sub

回答No.2

kybo · ベストアンサー

宣言している変数と使用している変数が全然ばらばらですね。
Dim newBook As Workbook
としているのに、
Set newB = Workbooks.Add
としてみたり。

あと、表は1行目からあるのに、
gyou = 4
としているのは？gyou = 1では？

この辺とか無茶苦茶ですよ。アクティブでないブックはちゃんとシート名も明示しないと。
Rows(gyou).Copy newBook.Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
「newBook.Cells」はおかしい。newSheet.Cellsです。基本：ブック.シート.セルの順なので。

一応訂正サンプルつけておきます。訂正はご容赦。

Sub Search_Click()
Dim SearchWord As String
Dim gyou As Long
Dim word As String
Dim LastRow As Long
Dim count As Integer
Dim baseBook As Workbook
Dim newBook As Workbook
Dim baseSheet As Worksheet
Dim newSheet As Worksheet
SearchWord = cmbsSyutokubutu_search.Text
Set baseBook = ThisWorkbook
Set baseSheet = baseBook.Worksheets("Sheet1")
baseSheet.Activate
With Worksheets("Sheet1")
count = 0
gyou = 1
LastRow = baseSheet.Cells(Rows.count, 5).End(xlUp).Row
Set newBook = Workbooks.Add
Set newSheet = newBook.Worksheets("Sheet1")
Do While baseSheet.Cells(gyou, 3) <> ""
word = baseSheet.Cells(gyou, 3)
If InStr(word, SearchWord) >= 1 Then
baseSheet.Rows(gyou).Copy newSheet.Cells(newSheet.Rows.count, 1).End(xlUp).Offset(1, 0)
End If
gyou = gyou + 1
Loop
End With
End Sub

お礼

早速教えて頂き大変ありがとうございました。ご指摘の通り、変数宣言している名前と実際に使っている名前が違っていました。それから、現在どのシートやセルを扱っているのかが分かっていなかったということがよく分かりました。訂正して頂きましたコードの通りにすれば、私の希望する動きをしてくれました。本当に大変助かりましたし、勉強になりました。Excel VBAは調べながらやっていたので、きちんと基本から勉強しないといけないことがよく分かりました。ありがとうございました。

回答No.1

temtecomai2

試してません。サッと見ただけです。

With Worksheets("Sheet1")
　　count = 0
　　gyou = 4
　　LastRow = baseSheet.Cells(Rows.count, 5).End(xlUp).Row
　　Set newB = Workbooks.Add
　　Set newS = newBook.Worksheets("Sheet1")

　　Do While Cells(gyou, 3) <> ""
　　　　word = Cells(gyou, 3)
　　　　If InStr(word, SearchWord) >= 1 Then
　　　　　　Rows(gyou).Copy newBook.Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
　　　　End If
　　　　gyou = gyou + 1
　　Loop
End With

試してませんが、上記の With Worksheets("Sheet1") と End With は不要だと思う。
で、それは今回の問題とは別の話。
不具合の原因としては
　　Do While Cells(gyou, 3) <> ""
　　　　word = Cells(gyou, 3)
　　　　If InStr(word, SearchWord) >= 1 Then
　　　　　　Rows(gyou).Copy newBook.Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
　　　　End If
　　　　gyou = gyou + 1
　　Loop
って部分に Cells とか Rows って出てきますが、コレがどのブックのどのシートを参照しているのか、あなたの期待する参照先と、プログラムが実際に参照している参照先とが違っているのでは？
Set newS = newBook.Worksheets("Sheet1")
を実行すると新規ブックがアクティブになるため、その後の Cells や Range はブックを指定していないため、新規ブックの先頭のシートを参照していると思います。

newsheet とか basesheet とか、シートを参照している変数を使っているのだから
newsheet.Cells とかの書き方にしてみてください。

お礼

丁寧に教えて頂きましてありがとうございました。おっしゃる通り、私は現在どのシートやセルを参照させたいのかを記述できていなかったとよく分かりました。ネットで調べながらやっているので、イマイチ基本的な部分が分かっておりませんでした。このように親切に教えて頂き、大変助かりましたし、勉強になりました。ありがとうございました。