Te anexo la macro actualizada
Sub generO()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Dim fecha As Date
Set h1 = Sheets("Obrador")
Set h2 = Sheets("CalenO")
'h2.UsedRange.Offset(2, 3).ClearContents
'uf2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 6
'uc2 = h2.Cells(5, Columns.Count).End(xlToLeft).Column + 4
h2.Range(h2.Cells(6, "C"), h2.Cells(15, "ND")).ClearContents
c = 6
For i = 27 To 397
Application.StatusBar = "Procesando fecha: " & Format(h1.Cells(i, "C"), "dd/mm/yyyy")
For j = Columns("H").Column To Columns("BP").Column Step 6
jcol = j
For n = 1 To 2
If h1.Cells(i, jcol) > 0 Then
fecha = h1.Cells(i, "C")
dato = "Obrador"
nombre = h1.Cells(1, j)
Set b = h2.Rows(5).Find(fecha, lookat:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
col = b.Column
Set b = h2.Columns("B").Find(dato, lookat:=xlWhole)
If Not b Is Nothing Then
fil = b.Row
existe = False
Do While h2.Cells(fil, col) <> ""
If InStr(1, h2.Cells(fil, col), nombre) > 0 Then
existe = True
Exit Do
End If
fil = fil + 1
Loop
horas = Format(h1.Cells(i, jcol), "hh:mm") & "-" & Format(h1.Cells(i, jcol + 1), "hh:mm")
If existe Then
h2.Cells(fil, col) = h2.Cells(fil, col) & "/" & horas
Else
h2.Cells(fil, col) = h1.Cells(1, j) & " " & horas
End If
Else
'MsgBox "Revisar"
End If
Else
'MsgBox "revisar"
End If
End If
jcol = jcol + 2
Next
Next
c = c + 1
Next
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Gener actualitzat"
End Sub
![](//blob.todoexpertos.com/uploads/md/b8f14601dd686e613f8e5a1fa2015858.gif)
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias