|
▼カンジ さん:
すでに Like演算子で解決済みのようですが、
複数セルを抽出するなら オートフィルタを使ってもよいかと思います。
Dim GOOD As String
Dim c As Range 'コピー先セル
With Sheets("GOOD情報") 'ここに検索したセルを集める
GOOD = .Range("F1").Value 'F1は家族など
Set c = .Range("B1000").End(xlUp).Offset(1) 'コピー先
End With
With Sheets("元データ")
.FilterMode = False
With .Range("A1").CurrentRegion '検索対象のシート
.AutoFilter 2, "*" & GOOD & "*" 'GOOD を含む文字列の行を抽出
If WorksheetFunction.Subtotal(3, .Columns(2)) > 1 Then
Intersect(.Columns("C:D"), .Offset(1)).Copy Destination:=c
End If
.AutoFilter
End With
End With
|
|