Ve se ajuda:
Sub arrumar_GT()
Application.ScreenUpdating = False
Dim EQUIPE As String
Dim i As Long
Dim UL As Long
Rows("1:11").Delete
Columns(1).Insert
Cells(1, "A").Value2 = "EQUIPE:"
Cells(1, "M").Value2 = "Prevista"
UL = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To UL
If Cells(i, "B").Value2 = "EQUIPE:" Then
EQUIPE = Cells(i, "C").Value2
Rows(i).Delete
End If
If Cells(i, "E").Value2 = "" _
Or Cells(i, "E").Value2 = "Eqpto" Then
Rows(i).Delete
i = i - 1
Else
Cells(i, "A").Value2 = EQUIPE
Range(Cells(i, "K"), Cells(i, "M")).Value2 = Range(Cells(i, "I"), Cells(i, "K")).Value2
Cells(i, "J").Value2 = Cells(i + 1, "C").Value2
Cells(i, "I").ClearContents
Range(Cells(i, "D"), Cells(i, "G")).Value2 = Range(Cells(i, "C"), Cells(i, "F")).Value2
Cells(i, "C").Value2 = Cells(i + 1, "B").Value2 & Cells(i + 2, "B").Value2
Rows(i + 1 & ":" & i + 2).Delete
End If
UL = Cells(Rows.Count, 2).End(xlUp).Row
If i + 1 >= UL Then Exit For
Next i
Range(Cells(1, 1), Cells(UL, "M")).ClearFormats
Range(Cells(1, 1), Cells(1, "M")).Font.Bold = True
Range(Cells(1, 1), Cells(UL, 1)).Font.Bold = True
With Range(Cells(1, 1), Cells(UL, "M")).Font
.Name = "Arial"
.Size = 7
End With
Range(Cells(2, "F"), Cells(UL, "I")).NumberFormat = "dd/mm"
Range(Cells(1, 1), Cells(UL, "M")).HorizontalAlignment = xlCenter
Range(Cells(1, 1), Cells(UL, 1)).HorizontalAlignment = xlLeft
Range(Cells(1, 3), Cells(UL, 3)).HorizontalAlignment = xlLeft
Range(Cells(1, 1), Cells(UL, "M")).Columns.AutoFit
End Sub
Postado : 09/01/2015 10:34 am