Transferência de dados entre planilhas com barra de progresso

[xandrinho]

Bom Dia Galera!!!
Preciso mto da ajuda dos mestres...A planilha anexa, cópia de dados, copia de uma aba para outra, no entanto gostaria de adaptar uma barra de progresso, pois a planilha terá mais de 10mil linhas...com isso a barra de progresso serviria de orientação à usuário...No fórum achei diversas explicações, mas já tentei de varias formas e sinceramente não consigo ter êxito...Geralmente aprendo o VBA analisando os códigos antes e dps...anexei um exemplo da barra de progresso...Poderiam por favor, me ajudar adaptar a barrar de progresso no arquivo cópia de dados?
Antecipadamente, mto obrigado por td ajuda!!!

[Mauro Coutinho]

No momento não tenho com ver seu arquivo, mas de uma olhada no link abaixo, e baixe o modelo, e veja se ajuda.

Barra de Progresso (ProgressBar)
http://www.planilhando.com.br/forum/vie ... bar#p55733

[]s

[xandrinho]

Grande Mauro Mto obrigado pela atenção, mas sei que soa até “mal”, mas poderia adptar para mim ado possível, até tentei mas não sei onde estou errando.....

[Mauro Coutinho]

xandrinho, pelo que vi em seu modelo, não tem como utilizar a barra de progresso devido a não termos o incremento do percentual.
Veja bem, sua rotina somente faz a cópia de uma aba inteira para outra, não estamos considerando linha a linha como na rotina da Barra de Progresso.

O que incrementa a Barra são os incrementos nestas linhas :
Verificamos a última linha
iUltimaLinha = ActiveSheet.Range("A1").End(xlDown).Row

Incrementamos o percentual conforme a qde de linhas,
For i = 2 To iUltimaLinha
iPercentualConcluido = i / iUltimaLinha

que no seu exemplo é analisada uma a uma e inserido um valor na frente de cada linha.

Código: Selecionar todos

Private Sub MinhaMacro1(ByVal rCell As Range)
    With rCell
        Select Case CInt(Left(.Offset(0, 1).Value, 1))
            Case 7, 8, 9
                .Offset(0, 2).Value = "Oi, " & .Value & ". Este número de telefone parece ser um celular!"
            Case Else
                .Offset(0, 2).Value = "Oi, " & .Value
        End Select
    End With
    
End Sub

Sua macro de copiar pode ser ajustada conforme abaixo, não precisamos do Select, é só enviar direto com o Copy Destination, e como pode ver é efetuado somente uma ação, o que não seria perceptível em uma barra de progresso

Código: Selecionar todos

Sub CopiarDados()

    'Copiar dados
    Sheets("Plan2").Range("A1:J500").Copy Destination:=Sheets("Plan1").Range("A1")
    
    Sheets("Plan1").Activate
    
    'Seleciona o intervalo de destino
    Range("A1").Select

End Sub

[]s