Boa tarde UserPlan,
Os erros que estão ocorrendo são do código antigo.
Os nomes ficam repetidos e ele dá erro.
Remove todo o código antigo e executa apenas o novo.
Outra coisa, os nomes das Sheets podem ser minúscula, no código coloquei para converter para maiúscula.
Alterei a relação dos nomes para maiúsculas, e outra coisa, a última Sheet está no plural. Estava dando erro também.
Tenta esse novo código:
'Obriga a declaração de variáveis
Option Explicit
'Variável global indicando que o loop está habilitado
Dim runLoop As Boolean
Public Sub onLoop() 'Essa macro inicia o loop
'Habilita a variável global para começar o loop
runLoop = True
'Agenda a execução da macro para a troca das Sheets
Call Application.OnTime(Now + TimeValue("00:00:05"), "Muda_Planilha")
End Sub
Public Sub OffLoop() 'Essa macro finaliza o loop
'Habilita a variável global para começar o loop
runLoop = False
'Seleciona a Sheet Meta Fat
DoEvents: ThisWorkbook.Sheets("Meta Fat").Select
End Sub
Sub VoltarParaInicio() 'Permaneci com essa macro
'Seleciona a Sheet Meta Fat
ThisWorkbook.Worksheets("Meta Fat").Select
End Sub
Public Sub Muda_Planilha() 'Essa macro faz o reconhecimento das Sheets e altera para a seguinte
'Declaração de variáveis
Dim ws() As Variant
'Verifica a variável global está habilitada, caso não esteja, finaliza o código
If runLoop = False Then Exit Sub
'Um array com o nome das planilhas a iniciar o loop em ordem
ws = Array("META FAT", "META PECAS", "META UNIT", "FAT ANUAL", "PECAS ANUAL", "UNIT ANUAL", "CLIENTES ANUAL")
'Seleciona a próxima planilha identificando a planilha atual
ThisWorkbook.Sheets(ws(IndiceSheet(UCase(ThisWorkbook.ActiveSheet.Name), ws))).Activate
'Chama o agendamento da macro para trocar as Sheets
Call onLoop
End Sub
Public Function IndiceSheet(ByVal wsName As String, ByVal ws As Variant) As Byte 'Essa macro retorna o índice da próxima Sheet
'Verificação de erro e desvia para o final do código
On Error GoTo Primeiro
'Procura a posição em que a planilha ativa está em relação as planilhas indicadas no array
IndiceSheet = Application.Match(wsName, ws, 0)
'Verifica se chegou na última planilha
If IndiceSheet = UBound(ws) + 1 Then IndiceSheet = 0
'Finaliza a função
Exit Function
'Rótulo indicado no caso de erro
Primeiro:
'Indica para a primeira Sheet
IndiceSheet = 0
End Function
Qualquer coisa da o grito.
Abraço
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 17/10/2017 1:41 pm