|
項目行を含めてコピーするなら
>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
|
|