Sub 抽出条件付き書式の黄色セルの行()
Dim ws As Worksheet
Dim newWs As Worksheet
Dim lastRow As Long
Dim rowCounter As Long
Dim cell As Range
Dim yellowColor As Long
yellowColor = RGB(255, 255, 0) ' 黄色の色を指定
' 作業するシートを設定
Set ws = ThisWorkbook.Sheets("sheet1")
' 新しいシートを作成
Set newWs = ThisWorkbook.Sheets.Add
newWs.Name = "抽出された行"
' 元のシートの最終行を取得
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' 行ごとにループ
For rowCounter = 1 To lastRow
' 行の各セルをチェック
For Each cell In ws.Range("A" & rowCounter & ":Z" & rowCounter) ' 列範囲を適切に設定
If cell.DisplayFormat.Interior.Color = yellowColor Then
' 条件付き書式の黄色のセルが見つかったら、行全体を新しいシートにコピー
ws.Rows(rowCounter).Copy Destination:=newWs.Rows(newWs.Cells(newWs.Rows.Count, 1).End(xlUp).Row + 1)
Exit For
End If
Next cell
Next rowCounter
End Sub