Muca Costa

Tem um erro no código, trocar: De: Lin = Lin + 1  End If Para: End If Lin = Lin + 1 =========================================================================== Porém acho que com as macros abaixo, deve funcionar melhor: Sub Transferir() Dim sStatusProcesso As String, A As String, UltimaLinha As String, Lin As String, i As Integer sStatusProcesso = "Aguarde... O sistema está CONSOLIDANDO as informações. " Application.StatusBar = sStatusProcesso Application.Calculation = xlCalculationManual Application.ScreenUpdating = False If Plan1.Range("I2") = "" Then MsgBox "Informe a Semana na célula I2", vbInformation, "© Muca Sistemas - 2019" Exit Sub End If With ActiveSheet A = .Cells(Rows.Count, 5).End(xlUp).Row Plan1.Range("G6:L" & A).ClearContents End With UltimaLinha = A Lin = 6 For i = 6 To UltimaLinha If Plan1.Cells(Lin, 5) = Plan1.Range("I2") Then If Plan1.Cells(Lin, 1) = Plan1.Range("H4") Then VaiVazia Plan1.Cells(Plan1.Range("G4"), 7) = Plan1.Cells(i, 3) Plan1.Cells(Plan1.Range("G4"), = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("I4") Then VaiVazia Plan1.Cells(Plan1.Range("G4"), 7) = Plan1.Cells(i, 3) Plan1.Cells(Plan1.Range("G4"), 9) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("J4") Then VaiVazia Plan1.Cells(Plan1.Range("G4"), 7) = Plan1.Cells(i, 3) Plan1.Cells(Plan1.Range("G4"), 10) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("K4") Then VaiVazia Plan1.Cells(Plan1.Range("G4"), 7) = Plan1.Cells(i, 3) Plan1.Cells(Plan1.Range("G4"), 11) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("L4") Then VaiVazia Plan1.Cells(Plan1.Range("G4"), 7) = Plan1.Cells(i, 3) Plan1.Cells(Plan1.Range("G4"), 12) = Plan1.Cells(i, 2) End If End If Lin = Lin + 1 Next Plan1.Range("I2").Select Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.StatusBar = sStatusProcesso & " Filtro finalizado" Application.StatusBar = False MsgBox "FIM" End Sub Sub VaiVazia() Dim i As Integer i = 5 Do While Range("G" & i).Value <> "" i = i + 1 Loop Range("G" & i).Select Plan1.Range("G4") = i End Sub

Tente assim: Crie um aba nomeando para CONSOLIDADO Selecione todas a planilhas e na célula G1 crie um contador =SE(CONT.VALORES(C1:C1000)=0;"";CONT.VALORES(C1:C1000)) Use a seguinte macro: Sub Consolidando() Dim ws As Worksheet Columns("A:F").Select Application.CutCopyMode = False Selection.ClearContents Range("A1").Select Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets If ws.Name <> "CONSOLIDADO" And ws.[G1] <> "" Then ws.Range("A1:F" & ws.Cells(Rows.Count, 1).End(3).Row).Copy Sheets("CONSOLIDADO").Cells(Rows.Count, 1).End(3)(2).PasteSpecial xlAll End If Next ws Application.ScreenUpdating = True MsgBox "Processo concluído.", vbInformation, "© Muca Sistemas - 2019" End Sub

Tente isso: Sub Transferir() Dim sStatusProcesso As String, A As String, UltimaLinha As String, Lin As String, i As Integer sStatusProcesso = "Aguarde... O sistema está CONSOLIDANDO as informações. " Application.StatusBar = sStatusProcesso Application.Calculation = xlCalculationManual Application.ScreenUpdating = False If Plan1.Range("I2") = "" Then MsgBox "Informe a Semana na célula I2", vbInformation, "© Muca Sistemas - 2019" Exit Sub End If With ActiveSheet A = .Cells(Rows.Count, 5).End(xlUp).Row Plan1.Range("G6:L" & A).ClearContents End With UltimaLinha = A Lin = 6 For i = 6 To UltimaLinha If Plan1.Cells(Lin, 5) = Plan1.Range("I2") Then If Plan1.Cells(Lin, 1) = Plan1.Range("H4") Then Plan1.Cells(Lin, 7) = Plan1.Cells(i, 3) Plan1.Cells(Lin, 8) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("I4") Then Plan1.Cells(Lin, 7) = Plan1.Cells(i, 3) Plan1.Cells(Lin, 9) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("J4") Then Plan1.Cells(Lin, 7) = Plan1.Cells(i, 3) Plan1.Cells(Lin, 10) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("K4") Then Plan1.Cells(Lin, 7) = Plan1.Cells(i, 3) Plan1.Cells(Lin, 11) = Plan1.Cells(i, 2) ElseIf Plan1.Cells(Lin, 1) = Plan1.Range("L4") Then Plan1.Cells(Lin, 7) = Plan1.Cells(i, 3) Plan1.Cells(Lin, 12) = Plan1.Cells(i, 2) End If Lin = Lin + 1 End If Next Plan1.Range("I2").Select Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.StatusBar = sStatusProcesso & " Filtro finalizado" Application.StatusBar = False End Sub

Talvez lhe seja útil: https://www.extendoffice.com/pt/documents/word/4533-word-replace-text-with-image.html

Tente isso: Sub AbreAba() Dim nome As String nome = InputBox("Insira o nome da Aba", "Abre Aba") Sheets(nome).Select End Sub

Veja se lhe atende. Click no botão "Atualizar Abas" ... Planilha em anexo. GERAL.rar

Veja se lhe ajuda a prosseguir... Incluí na aba GERAL três colunas (H, I, J) Em H1 Lista suspensa com base na coluna J Ao filtrar na lista, a coluna D é atualizada com o nome da Aba correspondente e a coluna D é atualizada com a ação BUY ou SELL Aí você clica no Botão correspondente (Filtrar BUY ou Filtrar SELL); será chamada a macro correspondente. Planilha anexada. Espero ter ajudado. GERAL.rar

Obrigado Edson Luiz Branco. Perfeito!

Gostaria de “enxugar” a macro, abaixo, que foi feita utilizando o gravador de macros. Sub Substituir() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "RTSum " .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "RTord " .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "RTAlç " .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "ET " .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Caixa" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Condenação" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Rural" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Causa" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Econômico" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "^g" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Ocupacional" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Indireta" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Trabalho" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Horas Extras" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Dano Moral" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Rescisória" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Acidentária" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Periculosidade" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Reavaliação" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Alimentação" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Ilegalidade" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Relação de Emprego" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "CLT" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Recolhimento" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Retificação" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Estabilidade" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Terceirização" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Dono da Obra" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Material" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Insalubridade" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Coletiva" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Processos - Minutar sentença" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Processo" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Pendente" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "desde" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Norma Coletiva" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "Reintegração" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll MsgBox "Substituições finalizadas" End Sub

Obrigado, esquece o EM TEMPO, é outra coisa...

g.schiavinatto bom dia, A automação não chega a tanto; na realidade a ação se daria via clique num botão. Como o campo “STATUS” é atualizado diariamente, ele fica sem dados nas datas posteriores, da pra atualizar a aba “PAUTAS” via macro a partir da primeira em branco. A solução de arquivar os esclarecidos é boa, porém, para fins estatísticos, preciso que a aba “Agenda” fique completa. Para sua opinião, anexo a planilha com a solução dada. Incluir dois botões: Deleta Pautas e Atualiza Pautas. EM TEMPO: Como seria se o critério ficasse em coluna fora da área de colagem. Exemplo: O critério está na coluna K porém pretende-se colar dados de A a H Teste.rar

Obrigado g.schiavinatto Deu certo; porém gostaria de automatizar via macro.

Preciso filtrar na aba “Agenda” processos com datas maiores que HOJE() e copiá-los para a aba “PAUTAS”. Seria filtrar as colunas B a H de “Agenda” e copiar para colunas B a H de “PAUTAS” Alguém poderia me ajudar? Arquivo modelo em anexo. Teste.rar

Igo amigo (http://forumatualgps.forumbrasil.net/t5961-igo-amigo-8-4-3-205081). Baixei e instalei na Central Multimidia Wings Play Corolla 800 X 480. Tá funcionado, porém corta o som de rádio, usb e TV. Só fica o som do GPS. Anteriormente usava o PRIMO cujo caminho era /SDHC/PRIMO/NaviOne/Navione.exe, sempre funcionou normalmente. Atualmente além do PRIMO/NaviOne, eu tenho Enterprise (http://gpsclube.com/...martifer-wince/) cujo caminho é SDHC/Enterprise/Enterprise.exe que, também funciona normalmente. O Amigo em questão está no caminho SDHC/Amigo/amigo.exe Como já disse, funciona com outros navegadores. Gostei muito dessa versão do Claudiotrg, por isso estou insistindo em resolver a questão. Se alguém puder ajudar, eu agradeço.

Obtive melhor resultado fazendo a seguinte alteração no procedimento BExtraiPartes(): De: posicaoInicial = InStr(1, cell.Value, "X ") + 1 Para: posicaoInicial = InStr(1, cell.Value, "CPF:") + 21