Tatyne Borges

Obrigada. Resolvido.

Obrigada. Vou ler e seguir as orientações. adicionado 9 minutos depois Antes de finalizar o tópico, gostaria de mais uma ajuda com o mesmo código. Fiz algumas alterações a pedido da pessoa que está utilizando a planilha: coloquei para organizar por data e não mais por prioridade. Só que agora ela quer que além de organizar por data, ao apagar o conteúdo da célula prioridade, a linha seja arrastada para o final da planilha. Hoje o código está assim: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 11 Then Exit Sub [B5].Sort Key1:=[B5], Order1:=xlAscending, Header:=xlYes End Sub Agenda - Clientes.rar

Ficou ótimo. Obrigada mais uma vez Osvaldomp.

Não tem necessidade de preencher todas as células, inclusive porque algumas ficarão vazias, a princípio. Eu gostaria que as linhas fossem reorganizadas quando o a célula PRIORIDADE fosse preenchida. Obrigada

Bom dia Pessoal, Andei pesquisando alguns tópicos anteriores para me ajudar na minha planilha, mas não consegui colocá-la para rodar de jeito nenhum. Espero que alguém possa me ajudar. A situação é a seguinte: gostaria de ordenar as linhas das planilhas de acordo com a coluna PRIORIDADE, na ordem crescente (1,2,3 - cima para baixo). Vou anexar a planilha e abaixo segue o código que iniciei (sem resultado): Private Sub Worksheet_Change(ByVal Sh As Object, ByVal Target As Range) If Not (Application.Intersect(Worksheets(1).Range("B6:K500"), Target) Is Nothing) Then Classificar End If End Sub Private Sub Classificar() Worksheets(1).Range("B6:K500").Sort Key1:=Worksheets(1).Range("B6"), Order1:=x1Ascending, _ Header:=xlYes End Sub Desde já agradeço a ajuda. Agenda - Clientes 2.rar

SENSACIONAL muito obrigada pela ajuda.

Eu havia anexado o arquivo excel sem a macro no primeiro post. Agora anexei a q estou trabalhando... tem um monte de coisa como comentário, pois estou testando. Estou testando a soma dos meses também DateAdd para atualizar a data das parcelas automático tb. Espero que possa me ajudar. Controle de Movimentação da Empresa - teste data.rar adicionado 43 minutos depois Consegui atualizar as parcelas em cada aba. Só não consegui ainda inserir a parcela (a linha) de acordo com data... somente no fim da planilha. Código atualizado abaixo: Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim LR As Long, k As Long, m As Long, x As Long, i As Long, LinSel As Long Dim lin As Integer Dim D1 As Date, D2 As Date, D3 As Date x = 1 lin = 15 If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value <> "" Then On Error GoTo kno Application.EnableEvents = False m = Target.Offset(, -1).Value - Target.Value: k = ActiveSheet.Index D1 = CDate(Target.Offset(, -12).Value) For i = k + 1 To k + m With Sheets(i) Do While Sheets(i).Cells(lin, 1).Value <> "" D2 = CDate(Sheets(i).Cells(lin, 1)) D3 = DateAdd("m", i - 1, D1) If CDate(D3) <= CDate(D2) Then LinSel = Sheets(i).Cells(lin, 1).EntireRow.Insert 'CopyOrigin:=xlFormatFromLeftOrAbove 'Sheets(i).Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Copy Sheets(i).Cells(x, 1) LR = .LinSel.Row .Cells(LR, 1).Resize(, 13).Value = _ Cells(Target.Row, 1).Resize(, 13).Value .Cells(LR, 1).Value = D3 .Cells(LR, 13).Value = .Cells(LR, 13).Value + x x = x + 1 'Selection.PasteSpecial xlPasteValues Else lin = lin + 1 End If Loop D3 = DateAdd("m", i - 1, D1) MsgBox (D3) LR = .Cells(Rows.Count, 1).End(3)(2).Row .Cells(LR, 1).Resize(, 13).Value = _ Cells(Target.Row, 1).Resize(, 13).Value .Cells(LR, 1).Value = D3 .Cells(LR, 13).Value = .Cells(LR, 13).Value + x x = x + 1 End With Next i kno: Application.EnableEvents = True End If End Sub

Obrigada Osvaldo, mas não consegui adaptar. O código disponibilizado acima por mim, faz o lançamento das parcelas de uma compra nas abas de cada mês. Ex: Fiz uma compra no dia 05/janeiro e parcelei em 3x, sendo q paguei a primeira em janeiro. Ele lança em janeiro, fevereiro e março. quando chega em fevereiro, fiz uma compra no dia 04/02 e parcelei em 2x, sendo q paguei a primeira em fevereiro. Ele lança fevereiro e março. Só que em março, a linha vai entrar no final da planilha e não antes do dia 05. Abaixo é possível um teste q estou fazendo com datas no mesmo mês, mas sendo lançadas fora de ordem para corrigir no mês seguinte: você pode notar que na última imagem eu já consegui comparar as datas e inserir a linha no local certo. Mas ainda não consegui copiar a linha e colar nela. Código novo abaixo: Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim LR As Long, k As Long, m As Long, x As Long, i As Long, LinSel As Long Dim lin As Integer Dim D1 As Date, D2 As Date, D3 As Date x = 1 lin = 15 If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value <> "" Then On Error GoTo kno Application.EnableEvents = False m = Target.Offset(, -1).Value - Target.Value: k = ActiveSheet.Index D1 = CDate(Target.Offset(, -12).Value) MsgBox (D1) For i = k + 1 To k + m With Sheets(i) Do While Sheets(i).Cells(lin, 1).Value <> "" D2 = CDate(Sheets(i).Cells(lin, 1)) If CDate(D1) <= CDate(D2) Then LinSel = Sheets(i).Cells(lin, 1).EntireRow.Insert 'CopyOrigin:=xlFormatFromLeftOrAbove x = x + 1 Else lin = lin + 1 End If Loop LR = .Cells(Rows.Count, 1).End(3)(2).Row .Cells(LR, 1).Resize(, 13).Value = _ Cells(Target.Row, 1).Resize(, 13).Value .Cells(LR, 13).Value = .Cells(LR, 13).Value + x x = x + 1 End With Next i kno: Application.EnableEvents = True End If End Sub Nõo sei se deu p entender...

Bom dia Pessoal, Estou elaborando uma planilha para fluxo de caixa e gostaria de uma ajuda: - atualmente, ao inserirmos um item parcelado/dividido, as parcelas futuras (as linhas) são inseridas na primeira linha em branco das planilhas seguintes. Entretanto, gostaria que as datas fossem verificadas e a linha inserida de acordo com a ordem cronológica. Tentei usar CDate, mas tive dificuldade em inserir a função antes de copiar a linha. Segue o arquivo e o código da macro abaixo: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim LR As Long, k As Long, m As Long, x As Long, i As Long x = 1 If Target.Count > 1 Then Exit Sub If Target.Column = 13 And Target.Value <> "" Then On Error GoTo kno Application.EnableEvents = False m = Target.Offset(, -1).Value - Target.Value: k = ActiveSheet.Index For i = k + 1 To k + m With Sheets(i) LR = .Cells(Rows.Count, 1).End(3)(2).Row .Cells(LR, 1).Resize(, 13).Value = _ Cells(Target.Row, 1).Resize(, 13).Value .Cells(LR, 13).Value = .Cells(LR, 13).Value + x x = x + 1 End With Next i kno: Application.EnableEvents = True End If End Sub Desde já agradeço a ajuda. Controle de Movimentação da Empresa - teste data.xlsx