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