With a few more validity checks:

Option Explicit
Sub testme()

Dim bcell As Range
Dim hh As String
Dim mm As String
Dim ss As String
Dim iRows As Long
Dim r As Long
Dim TestTime As Date

iRows = 55
r = 3
For Each bcell In Range("f51:f" & 20 + iRows).Cells
If IsNumeric(bcell.Value) Then
If Len(bcell.Value) = 6 Then
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
On Error Resume Next
TestTime = TimeSerial(hh, mm, ss)
If Err.Number < 0 Then
'something bad happened, skip it
Err.Clear
Else
With Sheets("sheet3").Cells(r, 5)
.NumberFormat = "hh:mm:ss"
.Value = TestTime
r = r + 1
End With
End If
On Error GoTo 0
End If
End If
Next bcell
End Sub



Dave Peterson wrote:

With no validity checks (to make sure that the fields are really numbers:

For Each bcell In Range("f51:f" & 20 + iRows).Cells
hh = Mid(bcell.Value, 1, 2)
mm = Mid(bcell.Value, 3, 2)
ss = Mid(bcell.Value, 5, 2)
Sheets("Sheet3").Cells(r, 5).Value _
= TimeSerial(hh, mm, ss)
r = r + 1
Next bcell

juancarlos wrote:

Im using the below macro to copy a group of cells to another sheet, but Im
getting an error message.

Can someone help me figure out what is wrong with the macro?

The idea is to copy the cell from text 180000 to 18:00:00 time

Dim bcell As Range '
Dim hh As String
Dim mm As String
Dim ss As String
r = 3
For Each bcell In Range("f51:f" & Trim(Str(20 + irows)))
hh = Mid(bcell, 1, 2)
mm = Mid(bcell, 3, 2)
ss = Mid(bcell, 5, 2)
sdate = hh & ":" & mm & ":" & ss
ddate = CDate(sdate)
Sheets("Sheet3").Cells(r, 5).Value = Format(ddate, "hh:mm:ss")
r = r + 1
Next bcell

--
Juan Carlos

--

Dave Peterson

--

Dave Peterson