Tatyne Borges

Obrigada. Resolvido. 

Obrigada. Vou ler e seguir as orientações. 

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

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