|
こんばんは。
↓のような感じで如何でしょうか?
貼り付け.xls を予め開いておき、ブック調査の必要な範囲を選択して実行してください。
なお、貼り付け.xlsの貼り付け先のシート名が不明のため"Sheet1"に貼り付けるものとしています。
☆マークの行の"Sheet1"を、実際のシート名に直してください。
Sub test()
Dim rngTemp As Range
Selection.AutoFilter Field:=3, Criteria1:="○"
On Error Resume Next
Set rngTemp = Selection.Offset(1). _
Resize(Selection.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
If rngTemp Is Nothing Then GoTo Exit_Sub
On Error GoTo 0
rngTemp.Copy Destination:=Workbooks("貼り付け.xls").Worksheets("Sheet1"). _
Range("A65536").End(xlUp).Offset(1) '☆
Exit_Sub:
Set rngTemp = Nothing
Selection.Parent.AutoFilterMode = False
Selection.Cells(1).Select
End Sub
|
|