■

' 画面更新を停止
Application.ScreenUpdating = False

' フィルター解除
リストシート.AutoFilterMode = False

' リストシートのB列の最終行を取得
最終行 = リストシート.Cells(Rows.Count, "B").End(xlUp).Row


' フィルターを設定
With リストシート.Range("B1:B" & 最終行)
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, Format(抽出日付, "m/d/yyyy"))
End With

' リストシートのB列の最終行を更新
最終行 = リストシート.Cells(Rows.Count, "B").End(xlUp).Row


' リストシートをアクティブにする
リストシート.Activate

' 新しいブックにリストシートをコピーして保存
Set 新しいブック = Workbooks.Add
Set 新しいシート = 新しいブック.Sheets(1)

' コピーしてすべて貼り付け
リストシート.Range("A1:I" & 最終行).Copy
新しいシート.Range("A1").PasteSpecial xlPasteAll

' A列からD列をコピーして値だけを貼り付け
リストシート.Range("A1:D" & 最終行).Copy
新しいシート.Range("A1").PasteSpecial Paste:=xlPasteValues

' 画面更新を再開
Application.ScreenUpdating = True