Creio que era isso que vc queria:
Sub distribuir_GT()
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim lin As Long
Dim UL As Long 'Última Linha
Dim obra() As String
UL = Cells(Rows.Count, 1).End(xlUp).Row
lin = UL + 1
For i = 2 To UL
If InStr(1, Cells(i, 5).Value2, "/") > 0 Then
obra() = Split(Cells(i, 5).Value2, "/")
Cells(i, 5).Value2 = obra(0)
For j = 1 To UBound(obra())
Range(Cells(i, 1), Cells(i, 6)).Copy Range(Cells(lin, 1), Cells(lin, 6))
Cells(lin, 5).Value2 = obra(j)
lin = lin + 1
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
Abs
Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.
Gilmar
Postado : 02/08/2014 6:02 pm