Option Explicit
'******************************************************************************
'内容：検索条件を指定し、結果を出力する
'******************************************************************************
Sub subFilter()
Dim BaseDir As String
Dim InpFile As String
Dim OutFile As String
Dim InpWkb As Workbook
Dim OutWkb As Workbook
Dim rngInp As Range
Dim rngJouken As Range
Dim rngOut As Range
'カレントパス取得
BaseDir = ThisWorkbook.Path
InpFile = BaseDir & "\" & "台帳.xls"
OutFile = BaseDir & "\" & "フィルタテスト.xls"
Set rngJouken = ThisWorkbook.Sheets("work").Range("検索条件")
Set rngOut = ThisWorkbook.Sheets("main").Range("C12")
Set InpWkb = Workbooks.Open(InpFile)
Set rngInp = InpWkb.Sheets("台帳").Cells(1, 1).CurrentRegion
rngInp.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngJouken, CopyToRange:=rngOut, Unique:=False
InpWkb.Close SaveChanges:=False
Set InpWkb = Nothing
End Sub
