※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

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