|
こんにちは。
>ご指摘いただいているオートフィルタでの抽出なのですが、検索する元データ種類が大変多く、その中から手作業で探しているととても時間がかかってしまう状況なのです。
???
オートフィルタでの抽出すれば、手作業で探している ことはないと思いますが・・
新しいシート("抽出用")を用意し、そのA1に抽出したいロットを記入して実行してみてください。
ただし、シートは提示したフォーマット以外のシートがないことが条件です。
かみちゃんから提示があったようにシートを回して、オートフィルターをかけています。
Sub test()
Dim SH As Worksheet
Dim myCrt As String
Application.ScreenUpdating = False
'抽出用シートの設定
With Sheets("抽出用")
.Range("A5").CurrentRegion.ClearContents
.Range("A5").Resize(, 4).Value = Array("ロット", "製造日", "個数", "品名")
myCrt = .Range("A1").Value
End With
'シートを回して、オートフィルター
For Each SH In ThisWorkbook.Worksheets
If SH.Name <> "抽出用" Then
With SH
.Range("A1").AutoFilter 1, myCrt
.AutoFilter.Range.Offset(1).Copy Sheets("抽出用").Range("A65536").End(xlUp).Offset(1)
.AutoFilterMode = False
End With
End If
Next
'抽出用シートを日付順にソート
With Sheets("抽出用")
.Range("A5").CurrentRegion.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortTextAsNumbers
End With
Application.ScreenUpdating = True
MsgBox "処理が終了しました"
End Sub
|
|