オートフィルタでデータを抽出する方法
今ある下のコードを実行すると、
別のシートに表示はされるのですが、
同じデータしか表示されない状態です
これをすべての条件のヒットするデータを
表示して、別シートにコピーしたいのですが・・・
レイアウトは、
使用者名 メーカー 車種 ナンバー 初年度登録 車検日 備考
です
A列の「使用者名」のところに同じ「使用者名」で、それ以降のB列の内容が違うデータが
複数あるので、「使用者名」が同じデータは、すべて表示されるようにしたいのですが、
これ以上どうしたらいいかわかりません。
つたない説明で大変申し訳ないのですが、ご教授願います
Sub CommandButton1_Click()
Dim 使用者名 As Variant
Dim cnt As Variant
With Worksheets(3)
.Select
.Range("A6").AutoFilter _
Field:=7, _
Criteria1:="=" & UserForm4.TextBox1, Operator:=xlAnd
.Range("A6").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("出力").Range("A6")
End With
Worksheets("出力").Activate
Columns("A:O").EntireColumn.AutoFit
With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
End With
cnt = 6
For 基点 = 1 To MaxRow
MsgBox (基点 & "です")
'まず検索用テキストボックスの中に文字の入力があるかどうかをチェックします。
If Not txtsiyousya.Value = Empty Then
'氏名の列であるA列の中に検索する氏名があるかどうかをチェックします。
Set 使用者名 = Columns("A:A").Find(txtsiyousya, LookIn:=xlValues)
'検索結果が発見できれば、そのセルをアクティブにします。
If Not 使用者名 Is Nothing Then
使用者名.Activate
Unload UserForm2
UserForm4.TextBox1.Text = ActiveCell.Offset(0, 0).Value
UserForm4.TextBox2.Text = ActiveCell.Offset(0, 1).Value
UserForm4.TextBox3.Text = ActiveCell.Offset(0, 2).Value
UserForm4.TextBox4.Text = ActiveCell.Offset(0, 3).Value
UserForm4.TextBox5.Text = ActiveCell.Offset(0, 4).Value
UserForm4.TextBox6.Text = ActiveCell.Offset(0, 5).Value
UserForm4.TextBox7.Text = ActiveCell.Offset(0, 6).Value
UserForm4.TextBox8.Text = ActiveCell.Offset(0, 7).Value
UserForm4.TextBox9.Text = ActiveCell.Offset(0, 8).Value
UserForm4.TextBox10.Text = ActiveCell.Offset(0, 9).Value
UserForm4.TextBox11.Text = ActiveCell.Offset(0, 10).Value
UserForm4.TextBox12.Text = ActiveCell.Offset(0, 11).Value
UserForm4.TextBox13.Text = ActiveCell.Offset(0, 12).Value
UserForm4.TextBox14.Text = ActiveCell.Offset(0, 13).Value
UserForm4.Show
cnt = cnt + 1
MsgBox (cnt)
'検索結果が発見できなければ、次のメッセージを表示します。
Else
MsgBox "検索した使用者は登録されていません"
txtsiyousya.Value = Empty
End If
Else
MsgBox "検索する使用者を入力して下さい"
End If
Next 基点
Range("A6").AutoFilter Field:=1, Criteria1:=UserForm4.TextBox1.Text
Worksheets("出力").Activate
Worksheets("ライフ").Activate
End Sub