Davi Spinetti

Boa Tarde gente, Precisava de uma macro que encontrasse todos os textos "X" na coluna B que esta oculta e copiasse o valores da mesma linha da coluna D, J E I para a planilha "CONSOLIDADOS", nas células A, B E C se alguém puder me ajudar agradeço. Att. Relatorio x.xlsx

Boa Tarde, Primeiramente obrigado, a macro funcionou em parte ela removeu tudo da certinho da coluna D porém da coluna J que tb tem "-" ela não removeu

Boa Noite Achei essa macro que faz exatamente o que eu preciso, porém qd chega a uma determinada quantidade de linha ela parra, sem apresentar erro apenas encerra e diz que foi concluído. Sub Executa() MsgBox "Foram excluídas " & ExcluiLinhasPorCriterio(1, 200, 6, "London") & " linhas" End Sub Function ExcluiLinhasPorCriterio(ByVal linhaInicial As Integer, ByVal linhaFinal As Integer, ByVal colunaCriterio As Integer, ByVal criterio As String) As Integer Dim linhasExcluidas As Integer Dim i As Integer linhasExcluidas = 0 With ActiveSheet i = linhaInicial While i < linhaFinal If CStr(.Cells(i, 4).Value) = "-" Then .Rows(i).Delete linhasExcluidas = linhasExcluidas + 1 Else i = i + 1 End If Wend End With ExcluiLinhasPorCriterio = linhasExcluidas

Boa noite, Preciso excluir da planilha em anexo as linhas que contiverem os valores " - " das células D e J e jogar o conteúdo ( se existir) para a cima (como o próprio Excel faz) confesso que sou leigo no assunto, achei essa macro que supostamente faz o que eu preciso, porém chega a um determinado valor ela da Erro e para, se alguém puder me ajudar agradeço. Sub limpar_relatorio() ' Excluir Inativos Application.ScreenUpdating = False Range("D:J").Select Dim w As Range Dim faixa As Range Set faixa = Selection Dim criterio As String criterio = "-" For Each w In faixa If InStr(1, w.Value2, criterio) <> 0 Then w.Activate ActiveCell.EntireRow.Delete Call Excluir_Inativos Exit Sub End If Next Application.ScreenUpdating = True End Sub BALIZAMENTO.xlsx

Boa noite, estou quebrando a cabeça com uma formula que talvez alguém possa me ajuda, preciso classificar e enumerar uma determinada coluna seguindo alguns critérios via formula. Critérios 1º: Series Coluna "N", todos devem receber uma numeração de acordo com a series que estão, cada serie precisa ter no minimo 3 pessoas, EX ( 13 pessoas 1º serie 5 pessoas; 2º series 5 pessoas; e 3º serie 3 pessoas ou segundo EX: 8 pessoas, 1º serie 4 pessoas, 2º serie 4 pessoas, etc...), o que determina a quantidade de pessoas por serie, se da pela contagem dos critérios; sexo (coluna "D") e categoria ("G).. Critério 2º: A divisão de quem vai ficar na 1 serie, ou 2 serie, ou qts series forem necessárias, se da pelo critério de ranqueamento já classificados na coluna"P", onde utilizei somarproduto, para me ajudar. Se alguém puder me ajudar ficarei muito agradecido, pois não tenho nem ideia de como solucionar isso, deixarei a planilha em anexo. BANCO DE DADOS.rar

Boa noite, desculpe não sou nenhum Expert no assunto, porém encontrei esse código na internet e ele faz exatamente o que eu preciso, ele um loop copiando os dados de varias planilhas (abas) de um mesmo arquivo, entretanto preciso que ele copie apenas os dados da primeira planilha ( aba "CONSOLIDADO") de cada arquivo e cole em formato especial "valores" e despreze as outras abas, se alguém puder me ajudar ficarei muito agradecido. 'UnificarPlanilhas Macro Sub lsUnificarPlanilhas() On Error GoTo Sair Dim lUltimaColunaAtiva As Long Dim lUltimaLinhaAtiva As Long Dim lRng As Range Dim sPath As String Dim fName As String Dim lNomeWB As String Dim lIPlan As Integer Dim lUltimaLinhaPlanDestino As Long PlanilhaDestino = ThisWorkbook.Name sPath = Localizar_Caminho sName = Dir(sPath & "\*.xl*") Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Do While sName <> "" fName = sPath & "\" & sName Workbooks.Open Filename:=fName, UpdateLinks:=False lNomeWB = ActiveWorkbook.Name For lIPlan = 1 To ActiveWorkbook.Sheets.Count Workbooks(lNomeWB).Worksheets(lIPlan).Activate lUltimaLinhaAtiva = Cells(Rows.Count, 1).End(xlUp).Row lUltimaColunaAtiva = ActiveSheet.Cells(1, 5000).End(xlToLeft).Column Set lRng = Range(Cells(1, lUltimaColunaAtiva).Address) Range("A" & 1 & ":" & gfLetraColuna(lRng) & lUltimaLinhaAtiva).Select Selection.Copy Workbooks(PlanilhaDestino).Worksheets(1).Activate lUltimaLinhaPlanDestino = Cells(Rows.Count, 1).End(xlUp).Row If lUltimaLinhaPlanDestino > 1 Then lUltimaLinhaPlanDestino = Cells(Rows.Count, 1).End(xlUp).Row + 1 End If Range("A" & lUltimaLinhaPlanDestino).Select ActiveSheet.Paste Application.CutCopyMode = False Next lIPlan Workbooks(lNomeWB).Close SaveChanges:=False sName = Dir() Loop MsgBox "Planilhas unificadas!" Sair: Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub Function gfLetraColuna(ByVal rng As Range) As String Dim lTexto() As String lTexto = Split(rng.Address, "$") gfLetraColuna = lTexto(1) End Function Public Function Localizar_Caminho() As String Dim strCaminho As String With Application.FileDialog(msoFileDialogFolderPicker) 'Permitir mais de uma pasta .AllowMultiSelect = False 'Mostrar janela .Show If .SelectedItems.Count > 0 Then strCaminho = .SelectedItems(1) End If End With 'Atribuir caminho a variável Localizar_Caminho = strCaminho End Function