|
▼うさこ さん:
フィルターオプション版もアップしておきますね。
Sub Sample3() 'フィルタ−オプション
Dim yy As Long
Dim mm As Long
Dim t1 As Variant
Dim t2 As Variant
Dim t3 As Variant
Application.ScreenUpdating = False
yy = 2012
mm = 7
With Sheets("Sheet1")
.Range("N1:O1").Value = .Range("A1").Value
.Range("N2").Value = ">=" & CDbl(DateSerial(yy, mm, 1))
.Range("O2").Value = "<" & CDbl(DateSerial(yy, mm + 1, 1))
t1 = .Range("A1:B1").Value
t2 = .Range("C1:G1").Value
t3 = .Range("H1:L1").Value
End With
With Sheets("Sheet2")
.UsedRange.ClearContents
.Range("A1:B1").Value = t1
.Range("C1:G1").Value = t2
Sheets("Sheet1").Columns("A:L").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("N1:O2"), CopyToRange:=.Range("A1:G1") _
, Unique:=False
End With
With Sheets("Sheet3")
.UsedRange.ClearContents
.Range("A1:B1").Value = t1
.Range("C1:G1").Value = t3
Sheets("Sheet1").Columns("A:L").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("N1:O2"), CopyToRange:=.Range("A1:G1") _
, Unique:=False
End With
Sheets("Sheet1").Range("N1:O2").Clear
Application.ScreenUpdating = True
End Sub
|
|