| 
    
     |  | 項目行を含めてコピーするなら >Range("A2").CurrentRegion
 より Sheets("元データ").AutoFilter.Range を使う方が適切な気もするけど、
 私ならフィルターそのものを使わず、数式で判定して処理します。例えば・・
 
 Dim strDate As String
 Dim MyR As Range
 
 strDate = TextBox1.Text
 With Worksheets("元データ")
 With .Range("C2", .Range("C65536").End(xlUp)).Offset(, 253)
 .Formula = _
 "=IF($C2=DATEVALUE(" & """" & strDate & """" & "),1)"
 .Value = .Value
 .Cells(1).Value = 1
 If WorksheetFunction.Count(.Cells) > 1 Then
 Set MyR = .SpecialCells(2, 1).EntireRow
 Intersect(MyR, .Parent.Range("A2").CurrentRegion) _
 .Copy Worksheets("結果").Range("A1")
 Application.GoTo Worksheets("結果").Range("A1"), True
 Set MyR = Nothing
 Else
 MsgBox "該当する日付が見つかりません", 48
 End If
 .ClearContents
 End With
 End With
 
 |  |