Excel VBA 選択したセルと同じ色のセルのデータを別シートに抽出する

Sub 色で別シート抽出()
Dim データ範囲 As Range
Dim 抽出セル As Range
Dim 抽出セル1 As Range
Dim 色セル As Range
Dim 色 As Long
 Set データ範囲 = Range("A1").CurrentRegion
 On Error GoTo エラー処理
 Set 色セル = Application.InputBox("抽出するセルの色と同じセルの色の単体セルを選択してください。", Type:=8)
     色 = 色セル.Interior.Color
 If 色 = 0 Then
     MsgBox "セル範囲ではなく単体のセルを選択してください。"
 Exit Sub
 End If
    Application.FindFormat.Clear
    Application.FindFormat.Interior.Color = 色
 Set 抽出セル = データ範囲.Find("", searchformat:=True)
 Set 抽出セル1 = 抽出セル
    Worksheets.Add(after:=Sheets(1)).Name = "抽出データ"
    Range("A1").Value = "抽出データ"
    Range("A2").Select
 Do
    ActiveCell.Value = 抽出セル.Value
    ActiveCell.Offset(1, 0).Select
 Set 抽出セル = データ範囲.Find("", after:=抽出セル, searchformat:=True)
 Loop While 抽出セル1.Address <> 抽出セル.Address
    Application.FindFormat.Clear
エラー処理:
End Sub

19行目【Worksheets.Add(after:=Sheets(1)).Name = “抽出データ”】
Worksheets【ﾜｰｸｼｰﾂ】コレクションのAdd【ｱﾄﾞ】メソッドを使用して、ワークシートを追加します。Worksheet【ﾜｰｸｼｰﾄ】オブジェクトのName【ﾈｰﾑ】プロパティを使用してシート名を「抽出データ」に設定します。

20行目【Range(“A1”).Value = “抽出データ”】
アクティブになっている追加した「抽出データ」シートのA1セルに「抽出データ」の文字列を代入します。

21行目【Range(“A2”).Select】
アクティブになっている追加した「抽出データ」シートのA2セルを選択します。

22行目【Do】
Do Loop While【ﾄﾞｩﾙｰﾌﾟﾜｲﾙ】ステートメントで繰り返し処理の始まりです。

23行目【ActiveCell.Value = 抽出セル.Value】
最初の繰り返し処理でアクティブになっている「抽出シート」のA2セルに16行目で実行したFind【ﾌｧｲﾝﾄﾞ】メソッドで検索されたセルの値をRange【ﾚﾝｼﾞ】オブジェクトのValue【ﾊﾞﾘｭｰ】メソッドで取得して代入します。

24行目【ActiveCell.Offset(1, 0).Select】
Range【ﾚﾝｼﾞ】オブジェクトのOffset【ｵﾌｾｯﾄ】プロパティを使用して、アクティブセルから1行下のセルを選択して、そのセルをアクティブにします。

25行目【Set 抽出セル = データ範囲.Find(“”, after:=抽出セル, searchformat:=True)】
データ範囲が格納されている変数「データ範囲」に検索するFind【ﾌｧｲﾝﾄﾞ】メソッドを実行します。検索の開始位置を指定する引数after【ｱﾌﾀｰ】には、16行目で実行した最初のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索されたセルが格納されている変数「抽出セル」を設定し、すでに検索されたセルの次のセルから検索する設定にし、検索した結果をSet【ｾｯﾄ】キーワードを使用して、オブジェクト変数「抽出セル」に代入します。

26行目【Loop While 抽出セル1.Address <> 抽出セル.Address】
22行目の「Do」からここまでの処理を設定した条件を満たす間繰り返します。設定条件はオブジェクト変数「抽出セル1」のセルとオブジェクト変数「抽出セル」のセル番地をRange【ﾚﾝｼﾞ】オブジェクトのAddress【ｱﾄﾞﾚｽ】プロパティで取得して、セル番地が等しくない「＜＞」場合を設定条件に設定します。

つまり、変数「抽出セル1」には18行目で最初のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索された「セル」が格納されていて、変数「抽出セル」には、22行目以降の繰り返し処理内のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索された「セル」が次々に代入されます。変数「抽出セル1」と変数「抽出」のセル番地が一致したとき、すべてセルの検索が終了したことを表すので、繰り返し処理から抜け出します。

27行目【Application.FindFormat.Clear】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのFindFormat【ﾌｧｲﾝﾄﾞﾌｫｰﾏｯﾄ】プロパティで取得した検索する書式を表すCellFormat【ｾﾙﾌｫｰﾏｯﾄ】オブジェクトをClear【ｸﾘｱ】メソッドで削除します。書式検索は、検索設定が残ってしまうので、書式検索した場合は検索書式を必ず、削除します。