RafaVillani

@Jefferson TSkkkkk....realmente me esqueci do End If, não fiz o código no Excel, fiz direto aqui no fórum, e acabei me esquecendo de fechar o If, mas, o importante é que funcionou. @Jefferson TSVocê marcou seu próprio post como solução....rsrsrsrs

@Jefferson TSDê um enter nessa linha, após o Select e antes do Selection.

@Jefferson TSTente este código, onde estou agora não pude testar, se der erro me avise. Sub ExcluiLinha() Dim Tabela As ListObject Dim UltimaLinha As Long Set Tabela = Planilha9.ListObjects("Tabela11") UltimaLinha = Tabela.ListRows.Count If UltimaLinha = 1 Then MsgBox "Nenhum registro encontrado, impossível excluir!", vbInformation, "ERRO" Exit Sub Else: Call Desprotege Sheets("ficha_treino").Select Range("A13").Select Selection.End(xlDown).Select Selection.EntireRow.Delete Range("A13").Select Selection.End(xlDown).Select Call Protege End Sub RafaVillani

@genecioficialconsegui usando apenas uma célula. segue a fórmula: =SE(G2<=F2;" VIGENTE Falta(m) "&SE(DATADIF(G2;F2;"y")=0;"";DATADIF(G2;F2;"y")&" Ano(s), ")&SE(DATADIF(G2;F2;"ym")=0;"";DATADIF(G2;F2;"ym")&" Mês(es) e ")&SE(DATADIF(G2;F2;"md")=0;"";DATADIF(G2;F2;"md")&" Dia(s)")&" para o vencimento da CNH.";"VENCIDO a "&SE(DATADIF(F2;G2;"y")=0;"";DATADIF(F2;G2;"y")&" Ano(s), ")&SE(DATADIF(F2;G2;"ym")=0;"";DATADIF(F2;G2;"ym")&" Mês(es) e ")&SE(DATADIF(F2;G2;"md")=0;"";DATADIF(F2;G2;"md")&" Dia(s)")&" RENOVAR CNH.") RafaVillani

@Jefferson TSColoque este linha de comando antes do primeiro For. If LinhaListbox < 0 Then MsgBox "Nenhum registro selecionado!", vbInformation, "ERRO" Exit Sub End If RafaVillani

@Jefferson TSSubstitua essas linhas: Tabela1.DataBodyRange.Cells(L).Delete por Tabela1.ListRows(L).Delete e Tabela2.DataBodyRange.Cells(L).Delete por Tabela2.ListRows(L).Delete Veja se funciona assim, aqui funcionou com ambas as linhas. RafaVillani

@Jefferson TS, você vem criando seus posts no lugar errado (Programação-Outros-Visual Basic), por mais que VBA seja baseado em Visual Basic, acredito que o correto seria criar em Pacotes de Escritorio-Microsoft Office. Sobre sua dúvida, veja se o código lhe atende. Dim Tabela1 As ListObject, Tabela2 As ListObject Dim LinhaTabela1 As Long, LinhaTabela2 As Long Dim L As Long, LinhaListbox As Long Set Tabela1 = Planilha8.ListObjects("BASE_PRESENÇAS") Set Tabela2 = Planilha8.ListObjects("TABELA_PRESENÇAS") LinhaTabela1 = Tabela1.ListRows.Count LinhaTabela2 = Tabela2.ListRows.Count LinhaListbox = Me.ListBoxBAIXA.ListIndex For L = 1 To LinhaTabela1 If Tabela1.DataBodyRange.Cells(L, 2) = Me.ListBoxBAIXA.List(LinhaListbox, 1) Then Tabela1.DataBodyRange.Cells(L).Delete L = L - 1 End If Next L For L = 1 To LinhaTabela2 If Tabela2.DataBodyRange.Cells(L, 2) = Me.ListBoxBAIXA.List(LinhaListbox, 1) Then Tabela2.DataBodyRange.Cells(L).Delete Exit Sub End If Next L RafaVillani

@Jefferson TSConsegui melhorar o filtro por parte do nome, agora ele funciona com o cabeçalho fixo, se lhe interessar basta substituir todo o código da Sub FiltroParte por esse: Dim linhamatriz As Long, Linha As Long Dim ultimalinha As Range Dim fonte(1 To 500, 1 To 6) As Variant Dim Cont As Integer Dim L As Long linhamatriz = 1 Linha = 6 Cont = 4 Me.ListBoxFIADO.RowSource = Empty Me.ListBoxFIADO.ColumnHeads = True L = Planilha5.Range("A5").CurrentRegion.Rows.Count + 4 Planilha5.Range("A5:F" & L).ClearContents Set ultimalinha = Plan1.Range("A1000000").End(xlUp) Plan1.Select With Plan1 Do While Linha <= ultimalinha.Row If UCase(.Cells(Linha, 2)) Like UCase("*" & (TextBox1) & "*") Then fonte(linhamatriz, 1) = .Cells(Linha, 1) fonte(linhamatriz, 2) = .Cells(Linha, 2) fonte(linhamatriz, 3) = .Cells(Linha, 3) fonte(linhamatriz, 4) = .Cells(Linha, 4) fonte(linhamatriz, 5) = .Cells(Linha, 5) fonte(linhamatriz, 6) = .Cells(Linha, 6) Cont = Cont + 1 linhamatriz = linhamatriz + 1 End If Linha = Linha + 1 Loop End With If Cont = 4 Then Me.ListBoxFIADO.RowSource = Planilha5.Range("A5:F5").Address Exit Sub End If Planilha5.Select Planilha5.Range("A5:F" & Cont) = fonte Me.ListBoxFIADO.RowSource = Planilha5.Range("A5:F" & Cont).Address RafaVillani

@paulocezarpicos Sem problemas, tudo certo! Precisando é só chamar!

@GENECIOFICIALOlá, veja se lhe atende, para testar basta alterar a data de vencimento. RafaVillani dma-ant-vcto-dma-ap-vcto.xlsx

@paulocezarpicosEu usei a planilha do post #7, quando ocorre a mensagem de planilha bloqueada? Lembro que para fazer qualquer alteração na aba Geral, primeiro você deve desbloquear a planilha, caso contrario a mensagem irá aparecer mesmo. RafaVillani LEITURA4.rar

@paulocezarpicosSegue novamente a planilha. RafaVillani LEITURA4.rar

@paulocezarpicosSegue a planilha! RafaVillani LEITURA4.rar

@Jefferson TSVeja se lhe atende esse filtro por parte do texto. O único problema é, ao adicionar este filtro eu não consigo mais fazer o cabeçalho fixo, então você terá de fazer o cabeçalho manualmente, utilizando labels. RafaVillani CONTROLE NOVO - Copia.rar

@Mayara RezendeSe entendi direito isso deve resolver. Dentro do evento SelectionChange adicione o comando If antes de chamar sua Sub lsMover, assim: If ToggleButton1_onoff.Value = True Then lsMover Else: MsgBox "Favor Ativar Movimentação do Quadro!" Exit Sub End If RafaVillani

@paulocezarpicosSegue a planilha com o filtro muito mais rápido. Lembrando que, conforme sua aba maio2021 você apenas pode filtrar um intervalo de 30 dias. RafaVillani LEITURA.rar

@paulocezarpicos Mas está dessa forma, você deve inserir as datas nos textbox do userform. Dessa forma esta muito lento, estou escrevendo um código mais rápido. Assim que finalizar eu envio a planilha. RafaVillani

@paulocezarpicosRespondi no outro tópico. RafaVillani

@paulocezarpicosVeja se lhe atende, esta um pouco lento devido ao número de informações. RafaVillani LEITURA.rar

@Jefferson TSDentro do botão baixar crie uma nova variável: Dim linhapago As Long e, entre as linhas de comando Plan1.Cells(L, 7) = Date e cont = 1, cole este código: linhapago = Plan2.Range("A4").CurrentRegion.Rows.Count + 4 Plan2.Cells(linhapago, 1) = Plan1.Cells(L, 1) Plan2.Cells(linhapago, 2) = Plan1.Cells(L, 2) Plan2.Cells(linhapago, 3) = Plan1.Cells(L, 3) Plan2.Cells(linhapago, 4) = Plan1.Cells(L, 4) Plan2.Cells(linhapago, 5) = Plan1.Cells(L, 5) Plan2.Cells(linhapago, 6) = Plan1.Cells(L, 6) Plan2.Cells(linhapago, 7) = Plan1.Cells(L, 7) Plan1.Rows(L).Delete RafaVillani

@Jefferson TS Tem sim, faça as seguintes alterações: No evento Initialize do UserFormBAIXAR_FIADO insira este código abaixo da linha TextBoxDATA_FIADO = Date L = Plan1.Range("A4").CurrentRegion.Rows.Count + 3 Set base = Plan1.Range(Plan1.Cells(5, 1), Plan1.Cells(L, 7)) NOME = "'" & Plan1.Name & "'!" ListBoxFIADO.RowSource = NOME & base.Address ListBoxFIADO.ColumnCount = 7 ListBoxFIADO.ColumnHeads = True If L = 1 Then ListBoxFIADO.ColumnHeads = False End If E substitua todo o código da Sub FiltroFiado por este: Dim base As Range Dim crt As Range Dim filtrada As Range Dim NOME As String Dim L As Long Set base = Plan1.Range("A4").CurrentRegion Set crt = Planilha5.Range("J1:P2") base.AdvancedFilter xlFilterCopy, crt, Planilha5.Range("A4:G4") L = Planilha5.Range("A4").CurrentRegion.Rows.Count Set filtrada = _ Planilha5.Range(Planilha5.Cells(5, 1), Planilha5.Cells(L + 3, 7)) NOME = "'" & Planilha5.Name & "'!" UserFormBAIXAR_FIADO.ListBoxFIADO.RowSource = NOME & filtrada.Address If L = 1 Then UserFormBAIXAR_FIADO.ListBoxFIADO.ColumnHeads = False End If Isso fará o cabeçalho ficar fixo. Tem como sim, mas teriamos que alterar a forma como os dados são carregados na listbox, e isso atrapalharia o Filtro, para contornar isso, aconselho você criar uma nova aba, "Pagos\Baixados" por exemplo, e ao clicar no botão Baixar a data é inserida e os dados baixados enviados para a planilha "Pagos\Baixados", dessa forma o listbox sempre irá listar apenas os devedores. RafaVillani

@Jefferson TSVamos lá, primeiro altere algumas propriedades do UserFormBAIXAR_FIADO e do ListBoxFIADO, para configura-los corretamente, conforme abaixo. UserFormBAIXAR_FIADO propriedade Width coloque 580 ListBoxFIADO propriedade ColumnWidths coloque 60 pt;100 pt;49.95 pt;60 pt;75 pt;55 pt;49.95 pt propriedade MultiSelect coloque 1-fmMultiSelectMulti prorpiedade Width coloque 545 Dentro do evento Click do botao Baixar cole este código: Dim i As Integer, L As Long, cont As Integer Dim linha As Long cont = 0 linha = Plan1.Range("A4").CurrentRegion.Rows.Count + 3 For i = 0 To ListBoxFIADO.ListCount - 1 If ListBoxFIADO.Selected(i) = True Then For L = 6 To linha If Plan1.Cells(L, 1) = ListBoxFIADO.List(i, 0) And Plan1.Cells(L, 2) = ListBoxFIADO.List(i, 1) _ And Plan1.Cells(L, 3) = ListBoxFIADO.List(i, 2) And Plan1.Cells(L, 4) = ListBoxFIADO.List(i, 3) _ And Plan1.Cells(L, 5) = ListBoxFIADO.List(i, 4) And Plan1.Cells(L, 6) = ListBoxFIADO.List(i, 5) Then Plan1.Cells(L, 7) = Date cont = 1 End If Next End If Next If cont = 1 Then Call FiltroFiado End If Crie uma nova Sub, duplo clique no UserFormBAIXAR_FIADO e cole este código: Sub Soma_Selecao() Dim Item As Integer Dim Soma As Double Soma = 0 For Item = 0 To ListBoxFIADO.ListCount - 1 If ListBoxFIADO.Selected(Item) = True And IsNumeric(ListBoxFIADO.List(Item, 5)) = True Then Soma = Soma + ListBoxFIADO.List(Item, 5) End If Next TextBoxTOTALFIADO = Format(Soma, "R$ #,##0.00") End Sub Dentro do envento MouseUp do ListBoxFiado cole este código: Call Soma_Selecao Uma dica, altere o local de armazenamento inicial da sua ID para que essa linha não apareça nos listbox, tanto na aba Base quanto na aba CONVENIÊNCIA, apenas questão de estética, elas podem ser inicializadas em qualquer célula da planilha, K1 por exemplo, não precisa estar dentro da tabela. RafaVillani

@Jefferson TSOlá, este erro ocorre por duas razões, primeiro porque você esta tentando filtrar as informação da aba BASE, quando deveria filtrar os dados da aba CONVENIÊNCIA, na Sub FiltroFiado substitua essa linha Set base = Planilha1.Range("A4").CurrentRegion por essa Set base = Plan1.Range("A4").CurrentRegion segundo porque você esta inserindo o nome do cliente na célula errada, a célula M2 da aba FILTRO_FIADO corresponde à quantidade, e não ao Cliente (Célula K2), dentro do comboboxCLIENTE_FIADO substitua essa linha Planilha5.Range("M2") = ComboBoxCLIENTE_FIADO.Value por esta Planilha5.Range("K2") = ComboBoxCLIENTE_FIADO.Value Dessa forma irá funcionar. RafaVillani

@paulocezarpicosSem problemas, precisando é só chamar!

@paulocezarpicosAcredito que não seja possível inserir um código VBA automaticamente após a inserção de uma nova aba na planilha (se é possível, eu desconheço). O que eu aconselho você a fazer é deixar as planilhas fixas, 12 planilhas representando os meses do ano, janeiro, fevereiro...até dezembro, já com os códigos VBA, e uma outra planilha onde será feito o controle anual conforme as planilhas mensais. E um botão tipo reset para poder apagar as planilhas mensais ao final de cada ano. Se o cliente quiser analisar as leituras anteriores elas estarão nessa outra planilha disposta por ano e mês. RafaVillani