Diogo Muscardi

Bom dia, Estou escrevendo um código para distribuir e atribuir atividades igualitariamente entre um grupo de funcionários. O código está distribuindo de forma correta porém ele trava o excel. Ele apenas funciona corretamente quando pauso a execução do macro antes de ele travar o funcionamento do excel. Não estou conseguindo encontrar o erro no código. Sub AtribuirAtividades() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(5) ' Ajuste o índice se necessário Dim ultimaLinha As Long ultimaLinha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row Dim funcionarios() As Variant Dim i As Long ' Nomes dos funcionários funcionarios = Array("Diogo", "Yanna", "Débora", "Adenilson", "Analista 1", "Analista 2") ' Tipos de atividade Dim tiposAtividade() As Variant ReDim tiposAtividade(1 To 1) ' Inicializar com um tamanho mínimo ' Contagem de atividades por tipo Dim contagemAtividadesPorTipo As Long contagemAtividadesPorTipo = 0 ' Identificar tipos de atividade e contar a quantidade de cada tipo For i = 781 To ultimaLinha If Not IsEmpty(ws.Cells(i, 3).Value) Then Dim tipoAtividade As String tipoAtividade = CStr(ws.Cells(i, 3).Value) If Not ExisteTipoAtividade(tiposAtividade, tipoAtividade) Then contagemAtividadesPorTipo = contagemAtividadesPorTipo + 1 tiposAtividade(contagemAtividadesPorTipo) = tipoAtividade ReDim Preserve tiposAtividade(1 To UBound(tiposAtividade) + 1) End If End If Next i ' Calcular a quantidade média de atividades por tipo e por funcionário Dim mediaAtividadesPorTipo As Double mediaAtividadesPorTipo = Application.WorksheetFunction.RoundUp(contagemAtividadesPorTipo / (UBound(funcionarios) + 1), 0) ' Atribuir atividades aos funcionários Dim contadorPorTipo As Long Dim contadorGeral As Long contadorGeral = 0 Do While contadorGeral < ultimaLinha For Each tipo In tiposAtividade For Each funcionario In funcionarios ' Atribuir atividade ao funcionário correspondente For i = 781 To ultimaLinha If ws.Cells(i, 3).Value = tipo Then If ws.Cells(i, 12).Value = "" Then ws.Cells(i, 12).Value = funcionario contadorGeral = contadorGeral + 1 contadorPorTipo = contadorPorTipo + 1 If contadorPorTipo >= mediaAtividadesPorTipo Then contadorPorTipo = 0 Exit For End If End If End If Next i If contadorGeral >= ultimaLinha Then Exit Do Next funcionario If contadorGeral >= ultimaLinha Then Exit Do Next tipo Loop End Sub Function ExisteTipoAtividade(ByVal tipos As Variant, ByVal tipo As Variant) As Boolean Dim i As Long For i = LBound(tipos) To UBound(tipos) If tipos(i) = tipo Then ExisteTipoAtividade = True Exit Function End If Next i ExisteTipoAtividade = False End Function