エクセルVBAで検索してシートへ貼り付け。

質問

どうも。
エクセルでVBAをやっています。

表に映画のデータベースのように打ち込んで
VBAフォームでタイトルを検索して、ヒットした行を別シートに出力するというのがやりたいのですが、できないのです。

Private Sub CommandButton1_Click()
'変数の宣言
strTitle = ""
intEndIndex = 0
intTate = 1
intYoko = 1

With Workbooks("book1.xls").Sheets(1)
strTitle = UserForm3("TextBox1")

i = 1
Do Until .Cells(i, 1) = ""
i = i + 1
Loop
'A1から下へ空白がでるまで検索する感じです。
intEndIndex = i - 1
Do Until intTate > intEndIndex
If strTitle = "" Then
Exit Do
ElseIf InStr(1, .Cells(intTate, intYoko), strTitle) > 0 Then
End If
intTate = intTate + 1
Loop
End With
End Sub

検索することはできるのですが、
ヒットした行（タイトルや監督や制作年、出演者などが表に書いてある)を別シートに貼り付ける方を教えてください。
よろしくお願いします。

回答No.4

happypoint

#1です。こんにちは。

＞2回目の検索の結果を1回目の検索の結果に上書きではなく、
＞その下の行から追加という形で出力

向上心が旺盛でいらっしゃいますね。^^

わたしのコードを修正する場合は、次の手順で修正してみて下さい。

（１）
まず、変数の定義に、次の行を追加してみてください。

　Static lngOffset As Long

この変数は、マクロが終わってもクリアされない「静的変数」として定義しています。
この変数で、前回の検索でシート２の何行目まで貼り付けたか、を覚えておくことができます。

（２）
つぎに、初期化のところを、こう変更します。
前のコードでは毎回1行目から貼り付けしていましたが、
今回は最終行以降に追加で貼り付けます。

　'初期化
　lngRow2 = lngOffset + 1 '前回検索して貼り付けたデータの、最終行の次の行に貼り付ける

（３）
最後に、最終行（End Subの直前）に、以下のコードを追加してください。
こうすることで、検索するごとに何行目まで貼り付けたかを記憶させることができます。

　lngOffset = lngRow2 - 1 '貼り付け先の最終行を記憶

お礼

早速の回答ありがとうございます。
できました。感動ですね^^。

回答読みながら「こうゆう手順でやるのかぁ」
とただただ驚くばかりです。
はやくhappypointさんのような考えが浮かぶようになりたいです。

まだまだ初心者の私は複数検索全てにヒットするのを出力するというのは課題が重すぎました。色々奮闘したのですが、これ以上考えがでてこない感じです。
ですので、御教授いただけると嬉しいです。
長くなるので補足に記入しときます。

ありがとうございました。

補足

はじめに回答くださったみなさんありがとうございました。
タイトルだけを検索して出力する方法をみなさんに教えていただき、それを応用して複数検索しようと挑んだのですが、まったくわからなくまた質問させていただきます。

フォームにはテキストボックス（タイトル、制作年、監督、主演）が4つとコンボボックス（ジャンル）が1つあって、その５つに入力した文字すべてと一致するものを出力したいのです。No.1の方の回答をもとに

Const lngTate As Long = 1 '行番号
Const lngYoko As Long = 1 'タイトルの列番号(固定)
Dim lngMaxRow As Long 'データの最終行
Dim lngRow1 As Long '貼り付けもとの行
Dim lngRow2 As Long '貼り付け先の行
Dim strTitle As String
Dim strYear As String
Dim strKantoku As String
Dim strShuen As String
Dim strGenre As String
Static lngOffset As Long

With Workbooks("book2.xls").Sheets(1)
strTitle = TextBox1.Value
strYear = TextBox2.Value
strKantoku = TextBox3.Value
strShuen = TextBox4.Value
strGenre = ComboBox1.Value

'初期化
lngRow2 = lngOffset + 1

'Textの取得
If TextBox1.Value = "" Then Exit Sub
strTitle = TextBox1.Value

If TextBox2.Value = "" Then Exit Sub
strYear = TextBox2.Value

If TextBox3.Value = "" Then Exit Sub
strKantoku = TextBox3.Value

If TextBox4.Value = "" Then Exit Sub
strShuen = TextBox4.Value

If ComboBox1.Value = "" Then Exit Sub
strGenre = ComboBox1.Value

'項目数を把握
Worksheets(1).Select
Cells(ActiveSheet.Rows.Count, lngYoko).End(xlUp).Select
lngMaxRow = Selection.Row

'検索して合致したらコピペ
For lngRow1 = 1 To lngMaxRow
If InStr(1, Cells(lngRow1, lngYoko).Value, strTitle) > 0 _
And InStr(1, Cells(lngRow1, 2).Value, strYear) > 0 _
And InStr(1, Cells(lngRow1, 3).Value, strKantoku) > 0 _
And InStr(1, Cells(lngRow1, 4).Value, strShuen) > 0 _
And InStr(1, Cells(lngRow1, 5).Value, strGenre) > 0 Then
Rows(lngRow1).Copy
Sheets(2).Cells(lngRow2, 1).PasteSpecial
lngRow2 = lngRow2 + 1
End If
Next lngRow1

'結果の表示
Worksheets(2).Select

lngOffset = lngRow2 - 1

End With
End Sub

というところまでやったのですが、これだと全てのボックスに文字を入力しないと検索できません。
一つでも未記入のボックスがあると検索ボタンを押しても反応なしです。
　InStr(1, Cells(lngRow1, lngYoko).Value, strTitle) > 0
が0なので空白だと一致しないというのは分かるのですが、空白ボックスがあっても検索できて、なおかつ入力した文字が全て含まれているものだけを出力したいのです。

例えば、タイトル「タイタニック」、制作年「1998」、監督「ジェームスキャメロン」、主演「レオナルド・ディカプリオ」、ジャンル「恋愛」という行があって、
タイトル「タイタニック」・ジャンル「恋愛」（制作年、監督、主演は未入力)と入力して他の行にジャンル「恋愛」のものがあってもタイタニックのみヒットさせたいのです。

非常に長くなってすいませんが、よろしくお願いいたします。