MACRO ORGANIZAR RELATÓRIO NÃO ESTA FUNCIONANDO

  Option Explicit


Sub OrgDados()
Dim shtOrigem   As Worksheet
Dim shtDestino  As Worksheet
Dim intUltRow   As Integer
Dim i, x, y, z  As Integer

Dim strCracha   As String
Dim strNome     As String


[ô]Habilitando tratamento de erros no código
On Error GoTo errTrat

[ô]Desabilitando a atualização de tela
Application.ScreenUpdating = False

[ô]Desabilitando calculos automaticos
Application.Calculation = xlCalculationManual

[ô]Carregando planilhas envolvidas nessa rotina
Set shtOrigem = ThisWorkbook.Sheets([Ô]Original[Ô])
Set shtDestino = ThisWorkbook.Sheets([Ô]Organizado[Ô])

[ô]Capturando a ultima linha preenchida (com base na coluna A)
intUltRow = shtOrigem.Range([Ô]A1048576[Ô]).End(xlUp).Row

[ô]Inicializando variavel que representa a linha da planilha Organizado
i = 4

[ô]Iniciando o lanço de repetição
For x = 10 To intUltRow [ô]Começa com 10 porque é a primeira linha com dados na planilha original
    [ô]Se a celula não for igual a GRUPO TONON BIOENERGIA S.A.
    If shtOrigem.Cells(x, 2).Value <> [Ô]GRUPO TONON BIOENERGIA S.A.[Ô] Then
        [ô]Se a celula não for um dia da semana e tiver conteudo
        If DiaDaSemana(shtOrigem.Cells(x, 2).Value) = False And VBA.Len(shtOrigem.Cells(x, 2).Value) > 0 Then
            strCracha = shtOrigem.Cells(x, 1).Value
            strNome = shtOrigem.Cells(x, 2).Value
            y = x + 1
            Do Until DiaDaSemana(shtOrigem.Cells(y, 2).Value) = False And VBA.Len(shtOrigem.Cells(y, 2).Value) > 0
                y = y + 1
                If y > intUltRow Then
                    Exit Do
                End If
            Loop
            [ô]Pula a execução caso não tenha informação ou seja um nome seguido de outro
            If x + 1 - y = 0 Then
                GoTo PULO
            End If
            
            [ô]Preenche as celulas conforme solicitado
            For z = x To y
                If DiaDaSemana(shtOrigem.Cells(z, 2).Value) = True Then
                    shtDestino.Cells(i, 1).Value = strCracha
                    shtDestino.Cells(i, 2).Value = strNome
                    shtDestino.Cells(i, 3).Value = shtDestino.Cells(i, 3).Value = VBA.CDate(VBA.CStr(VBA.Day(shtOrigem.Cells(z, 1).Value)) & [Ô]/[Ô] & VBA.CStr(VBA.Month(shtOrigem.Cells(z, 1).Value)) & [Ô]/[Ô] & VBA.Year(Now))
                    shtDestino.Cells(i, 4).Value = shtOrigem.Cells(z, 2).Value
                    shtDestino.Cells(i, 5).Value = VBA.Left(shtOrigem.Cells(z, 3).Value, 5)
                    shtDestino.Cells(i, 6).Value = VBA.Mid(shtOrigem.Cells(z, 3).Value, 7, 5)
                    shtDestino.Cells(i, 7).Value = VBA.Mid(shtOrigem.Cells(z, 3).Value, 13, 5)
                    shtDestino.Cells(i, 8).Value = VBA.Mid(shtOrigem.Cells(z, 3).Value, 19, 5)
                    i = i + 1
                End If
                
            Next
            
            [ô]Incremente a posição da variavel x
            x = y - 1
PULO:
            
        End If
    End If
Next

[ô]Caso a macro encontre um erro antes desse passo vem direto pra essa linha isso evita deixar a o excel com calculo manual
errTrat:

[ô]Desabilitando a atualização de tela
Application.ScreenUpdating = True

[ô]Desabilitando calculos automaticos
Application.Calculation = xlCalculationAutomatic

[ô]Casso tenha encontrado qualquer erro avisar ao usuario;
If Err.Number > 0 Then
    MsgBox [Ô]Operação abordada!!![Ô] & vbCrLf & vbCrLf & [Ô]Ocorreu um erro inesperado!!![Ô], vbOKOnly + vbCritical, [Ô]Mensagem de erro[Ô]
End If

[ô]Descarregando as planilhas carregadas nessa rotina
Set shtOrigem = Nothing
Set shtDestino = Nothing


End Sub

[ô]Essa função retorna verdadeiro se for um dia da semana ou falso caso não
Private Function DiaDaSemana(ByVal strDia As String) As Boolean
Select Case strDia
    Case [Ô]Seg[Ô], [Ô]Ter[Ô], [Ô]Qua[Ô], [Ô]Qui[Ô], [Ô]Sex[Ô], [Ô]Sab[Ô], [Ô]Dom[Ô]
        DiaDaSemana = True
    Case Else
        DiaDaSemana = False
End Select
End Function