Option Explicit
'****************************************************************************** '内容:検索条件を指定し、結果を出力する'******************************************************************************
Sub subFilter()
Dim BaseDir As StringDim InpFile As StringDim OutFile As String
Dim InpWkb As WorkbookDim OutWkb As Workbook
Dim rngInp As RangeDim rngJouken As RangeDim 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
このサイトはreCAPTCHAによって保護されており、Googleの プライバシーポリシー と 利用規約 が適用されます。
1文字以上入力してください
本文は少なくとも1文字以上必要です。
1文字以上入力してください。