Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

23547 / 76732

←次へ　｜　前へ→


	【58551】Re:複数シートからの検索・抽出方法

こぎつね - 08/10/29(水) 17:09 -


	引用なし

	パスワード

取り敢えずですが、抽出対象のシート名は修正して下さい。

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

こうゆう感じの事かなと思うのですが。

1 hits

▼

【58532】複数シートからの検索・抽出方法 ロシツキー 08/10/29(水) 1:20