Dave,
The difference with this one is that there is a vlookup involve in the macro.

The other one is working to move one set of data to another sheet, but what
I also need to do is move more of data to the last empty cell.

Sorry that my questions are not clear but Im very new on this.

Thanks

"Dave Peterson" wrote:

Didn't that get answered in your other post?

Dim DestCell as range

With worksheets("Sheet3")
set destcell = .cells(.rows.count,"N").end(xlup).offset(1,0)
end with

worksheets("sheet1").range("L51:L" & 20 + irows).copy
destcell.pastespecial paste:=xlpastevalues

Juan Carlos wrote:

Dave,
I have 2 more questions
The macro you created is moving data from F51-F75 to sheet 3. What can I add
to this macro so it also move data from F102-128 to sheet 3 in the last empty
cell in (r,5)

What can I add to macro below so it will do the following but also transfer
the data to the last empty row in column b.

Sheets("Sheet3").Range("b2:b" & Trim(Str(3 + iRows))) =
Application.VLookup(Range("c51:c" & Trim(Str(20 + iRows))),
Sheets("Sheet2").Range("$a$2:$b$6"), 2, False)
Thanks again

Juan
"Dave Peterson" wrote:

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:

I€„¢m using the below macro to copy a group of cells to another sheet, but I€„¢m
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


--

Dave Peterson