Sub get_sameday()
Worksheets("Sheet1").Activate
Dim i, pv
Dim vl
pv = 1
For i = 30 To 1 Step -1
vl = InStr(Cells(i, 1).Value, "即答")
If vl <> 0 Then
vd = Mid(Cells(i, 1).Value, 8, 3)
Worksheets("Sheet2").Activate
Cells(pv, 1).Value = vd
pv = pv + 1
Worksheets("Sheet1").Activate
End If
Next
End Sub