VBAでデータ抽出

フィルターをかけて抽出されたものをコピペするVBAをChatGPTくんに作らせました！

Sub フィルタコピーペースト()
    Dim ws As Worksheet ' 処理対象のシートを格納する
    Dim rngData As Range ' データの範囲を格納する
    Dim rngFiltered As Range ' フィルタリングされたデータの範囲を格納する
    Dim rngCopy As Range ' コピーする範囲を格納する
    
    ' フィルタを適用するシートを指定
    Set ws = ThisWorkbook.Worksheets("シート名") ' シート名を適切に変更
    
    ' データの範囲を指定（A列とC列のデータがある範囲）
    Set rngData = ws.Range("A1:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' フィルタを適用する列を指定（A列をフィルタリング）
    rngData.AutoFilter Field:=1, Criteria1:="フィルタ条件" ' フィルタ条件を適切に変更
    
    ' フィルタリングされた範囲を取得
    On Error Resume Next
    Set rngFiltered = rngData.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' フィルタリングされたデータのC列をコピー
    If Not rngFiltered Is Nothing Then
        Set rngCopy = rngFiltered.Columns(3).Offset(1) ' C列のデータをコピー（カラム名を除外するためOffset(1)を記述）
        rngCopy.Copy ' コピー
    End If
    
    ' フィルタを解除
    ws.AutoFilterMode = False
    
    ' コピー先のセルを指定して貼り付け
    ws.Range("E1").PasteSpecial xlPasteValues ' E1を適切な貼り付け先セルに変更
    
    ' コピー元のデータを削除（必要に応じて）
    rngCopy.ClearContents
    
    ' クリップボードをクリア
    Application.CutCopyMode = False
    
End Sub