leandromgp

Bom dia, Pessoal @Basole, estou utilizando a sua sub do seu exemplo (muito obrigado ajudou bastante), com algumas alterações para melhor me atender e estou tendo um problema na Private Sub SecondStep(). Ela esta pulando a linha SendKeys ("^v"), chega a selecionar a célula A8 e não copia. Eu olhei na área de transferência e existe dado copiado e ele segue os comando normalmente ativando o numlock e etc. Segue a Private sub: Private Sub SecondStep() SendKeys ("%fx") Myself = "Microsoft Excel - " & ActiveWindow.Caption ThisWorkbook.Activate Sheets("MODELO").Select Sheets("MODELO").Copy After:=Sheets(1) Range("A8").Activate SendKeys ("^v") SendKeys "{NUMLOCK}" Application.OnTime Now + TimeValue("00:00:10"), "thirdStep" End Sub

Boa Tarde Pessoal, Tenho uma Macro que executa um loop ate determinada condição e gostaria de chamar um modulo inteiro nessa macro. Existe algum comando que posso fazer isso? A instrução 1 (Módulo 2) esta funcionando perfeitamente, preciso colocar ela na instrução 1. Desde já agradeço... segue das instruções: Instrução 1: <Sub repeticao() Dim AdobeFile As String Sheets("ENTRADA").Select linha = 5 Do Until Cells(linha, = "" If Cells(linha, <> "" Then Cells(linha, 8).Select Call Módulo2 End If linha = linha + 1 Loop End Sub> Instrução 2 <Sub StartAdobe() Dim AdobeApp As String Dim AdobeFile As String Dim value As String Dim valor As String Dim StartAdobe AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" AdobeFile = ActiveCell StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1) Application.OnTime Now + TimeValue("00:00:05"), "FirstStep" End Sub Private Sub FirstStep() SendKeys ("^a") SendKeys ("^c") Application.OnTime Now + TimeValue("00:00:10"), "SecondStep" End Sub Private Sub SecondStep() SendKeys ("%fx") AppActivate "Excel" ThisWorkbook.Activate Sheets("MODELO").Select Sheets("MODELO").Copy After:=Sheets(1) Range("A1").Activate SendKeys ("^v") ActiveCellSendKeys "{NUMLOCK}" Application.OnTime Now + TimeValue("00:00:05"), "thirdStep" End Sub Private Sub thirdStep() Sheets("MODELO (2)").Select Set Rng = Range("A1") valor = "Data pregão" Do While Rng.value <> "" Rng.Select If Rng.value = valor Then Rng.Offset(1, 1).Select ActiveCell.FormulaR1C1 = _ "=YEAR(RC[-1])&TEXT(MONTH(RC[-1]),""00"")&TEXT(DAY(RC[-1]),""00"")" Sheets("MODELO (2)").Select Sheets("MODELO (2)").Name = Rng.Offset(1, 1).value Range("A1").Select Columns("A:A").EntireColumn.AutoFit Columns("B:B").EntireColumn.Delete Exit Sub End If Set Rng = Rng.Offset(1, 0) Loop End Sub> adicionado 6 minutos depois esse é o numero "8", não sei porque apareceu isso...

@Basole , Boa tarde prezado Basole, Eu criei um novo tópico com essa dúvida, se puder acessar lá e esclarecer essa dúvida agradeço demais...

Boa Tarde, Prezados, Motivado pelo fórum "https://www.clubedohardware.com.br/forums/topic/1292187-macro-utilizando-ocr-vba/?tab=comments" comecei a estudar VBA para otimizar as minhas tarefas do dia a dia. Porém estou com uma dúvida em fazer um loop para obter endereços de arquivos na linha AdobeFile = "D:\DADOS\1-Pessoal\9-Financas\3-Ações\1-Controle\1-Notas_de_Negociação\2019\1-JAN\NotaCorretagem_118195_20190110.pdf", não é pratico ficar mudando o nome do arquivo nessa linha e pensando nisso criei uma planilha ENTRADA para abrir todos os arquivos PDF (Coluna H), copia-los e salvar em abas separadas com respectivas datas como nome da planilha, ou seja que essa vba se repita enquanto tiver arquivos na coluna H da aba ENTRADA e quando encontrar uma linha vazia ela parasse. E aproveitando gostaria também que a VBA parasse quando fosse nomear uma planilha com nome existe (seria o mesmo arquivo PDF) Segue a VBA: Sub StartAdobe() Dim AdobeApp As String Dim AdobeFile As String Dim value As String Dim valor As String Dim StartAdobe AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" AdobeFile = "D:\DADOS\1-Pessoal\9-Financas\3-Ações\1-Controle\1-Notas_de_Negociação\2019\1-JAN\NotaCorretagem_118195_20190110.pdf" StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1) Application.OnTime Now + TimeValue("00:00:05"), "FirstStep" End Sub Private Sub FirstStep() SendKeys ("^a") SendKeys ("^c") Application.OnTime Now + TimeValue("00:00:10"), "SecondStep" End Sub Private Sub SecondStep() SendKeys ("%fx") AppActivate "Excel" ThisWorkbook.Activate Sheets("MODELO").Select Sheets("MODELO").Copy After:=Sheets(1) Range("A1").Activate SendKeys ("^v") SendKeys "{NUMLOCK}" Application.OnTime Now + TimeValue("00:00:05"), "thirdStep" End Sub Private Sub thirdStep() Sheets("MODELO (2)").Select Set Rng = Range("A1") valor = "Data pregão" Do While Rng.value <> "" Rng.Select If Rng.value = valor Then Rng.Offset(1, 1).Select ActiveCell.FormulaR1C1 = _ "=YEAR(RC[-1])&TEXT(MONTH(RC[-1]),""00"")&TEXT(DAY(RC[-1]),""00"")" Sheets("MODELO (2)").Select Sheets("MODELO (2)").Name = Rng.Offset(1, 1).value Range("A1").Select Columns("A:A").EntireColumn.AutoFit Columns("B:B").EntireColumn.Delete Exit Sub End If Set Rng = Rng.Offset(1, 0) Loop End Sub Desde Já Agradeço. Leandro

Boa Noite, Parabéns pela solução, me ajudou bastante !!! Gostaria de saber como faço para colocar uma caixa de endereço para selecionar um arquivo especifico?