|
取り敢えずですが、抽出対象のシート名は修正して下さい。
Sub try()
Dim r As Range
Dim rs As Range
Dim v
With Worksheets("検索用")
.Range("C10:O" & Rows.Count).ClearContents
For Each v In Array("A", "B") '抽出対象のシート名
Set r = .Range("C" & Rows.Count).End(xlUp).Offset(1)
If r.Row < 11 Then Set r = .Range("C11")
Worksheets(v).Columns("A:M").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=.Range("A3:F5")
Set rs = Intersect(Worksheets(v).Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible), _
Worksheets(v).Rows("2:" & Rows.Count))
If Not rs Is Nothing Then
.Range("C10:O10").Value = Worksheets("A").Range("A1:M1").Value
rs.Copy r
End If
Worksheets(v).ShowAllData
Application.CutCopyMode = False
Next
End With
End Sub
こうゆう感じの事かなと思うのですが。
|
|