Contador Sequencial

[Barucky]

Boa noite, Pessoal
Galerinha tenho acompanhados os posts do fórum é tão complexo para meu entendimento, que sei que minha dúvida a vocês será café com leite, kkkkkk.
Vamos lá,
Possuo uma planilha que atualmente consta 18 abas, com sua estrutura idênticas, adicionei um comando para passar por todas uma a uma.
Em cada uma das abas na coluna “F”, consta um texto Escrito “Boletim:”, este é meu critério de busca, cada aba pode variar a quantidade desse critério .
O que necessito é que ao encontrar este critério “Boletim:”, usando offset para direita na frente venha um contador começando do 00001 neste formato e vá colocando em sequência uma a pôs uma, e as outras abas continue da sequência da aba anterior.
Será que conseguem me ajudar mais uma vez, nesse que para mim é um desafio imenso?
No Aguardo!!!!

[srobles]

Barucky,

Experimente o exemplo abaixo :
Adicione o código em um novo módulo, e em um botão na planilha chame Call incrementaContador.

Código: Selecionar todos

Sub incrementaContador()
    'Desabilitamos a atualização de tela
    Application.ScreenUpdating = False
    
    'Variável para contarmos as abas da pasta
    Dim contPlanilhas As Integer
    contPlanilhas = ThisWorkbook.Sheets.Count
    
    'Variável para o nosso contador
    Dim contador As Integer
    contador = 0
    
       'Laço para passarmos as abas uma á uma
       For indicePlanilha = 1 To contPlanilhas
          With ThisWorkbook.Sheets(indicePlanilha)
            'Ativamos a planilha de índice indicePlanilha
             .Activate
                'Na coluna F, definimos o que pretendemos buscar
                With .Range("F:F")
                    .Range("A1").Select
                    Set buscaCriterio = .Find("Boletim:", LookIn:=xlValues)
                    'Se o valor for encontrado
                    If Not buscaCriterio Is Nothing Then
                        'Incrementamos o contador
                        contador = contador + 1
                        'Selecionamos a célula onde a palavra Boletim: foi encontrada
                        Range(buscaCriterio.Address).Select
                        'Formatamos a célula á frente dela como texto
                        ActiveCell.Offset(0, 1).NumberFormat = "@"
                            'Validamos o valor do contador
                            'e adicionamos seu valor já formatado na célula á frente
                            If contador <= 9 Then ActiveCell.Offset(0, 1) = CStr("0000" & CInt(contador))
                            If contador >= 10 And contador <= 99 Then ActiveCell.Offset(0, 1) = CStr("000" & CInt(contador))
                            If contador >= 100 And contador <= 999 Then ActiveCell.Offset(0, 1) = CStr("00" & CInt(contador))
                            If contador >= 1000 Then ActiveCell.Offset(0, 1) = CStr("0" & CInt(contador))
                            If contador >= 10000 Then ActiveCell.Offset(0, 1) = CInt(contador)
                            
                    End If
                End With
                
                'Variável do tipo inteiro para
                'retornar a ultima linha preenchida na planilha ativa
                Dim ultimaLinha As Integer
                'Armazenamos a ultima linha
                ultimaLinha = ActiveSheet.UsedRange.Rows.Count + 1
                
                'Laço para varremos as linhas sub-sequentes em busca
                'da palavra Boletim
                For vLinha = ActiveCell.Row + 1 To ultimaLinha
                    'Selecionamos a nova linha
                    .Cells(vLinha, "F").Select
                    'Se o valor dela for igual a Boletim:
                    If ActiveCell = "Boletim:" Then
                        'Incrementamos novamente o contador
                        contador = contador + 1
                        
                        'Formatamos a célula á frente dela como texto
                        ActiveCell.Offset(0, 1).NumberFormat = "@"
                            'Validamos o valor do contador
                            'e adicionamos seu valor já formatado na célula á frente
                            If contador <= 9 Then ActiveCell.Offset(0, 1) = CStr("0000" & CInt(contador))
                            If contador >= 10 And contador <= 99 Then ActiveCell.Offset(0, 1) = CStr("000" & CInt(contador))
                            If contador >= 100 And contador <= 999 Then ActiveCell.Offset(0, 1) = CStr("00" & CInt(contador))
                            If contador >= 1000 Then ActiveCell.Offset(0, 1) = CStr("0" & CInt(contador))
                            If contador >= 10000 Then ActiveCell.Offset(0, 1) = CInt(contador)
                        
                    End If
                Next
          End With
       Next
       
    'Selecionamos a primeira planilha ou aba
    ThisWorkbook.Sheets(1).Activate
    
    'Habilitamos a atualização de tela
    Application.ScreenUpdating = True
    
    'Informamos sobre a conclusão do processo
    MsgBox "Operação realizada com sucesso!" & Chr(13) & _
    "Total de " & contador & " registro(s) atualizado(s).", vbInformation, "Contagem de registros"
End Sub

Espero ter ajudado.

Abs

[Barucky]

Boa noite, rapaz era isso mesmo que precisava sem colocar nem tirar, maravilhoso!!!!
Até parece que anexei o arquivo para você, sensacional, você conseguiu pegar a verdadeira necessidade...
Agradecido de mais por esta grande ajuda, sucesso a este fórum...
Obrigado...!!!

[srobles]

Barucky,

Boa noite amigo!

Que bom que o exemplo lhe atendeu amigo.

Sucesso nos projetos e "vamo que vamo".

Abs