Excel Inserir Linha após conferir coluna Data - Linhas por ordem de data

[Tatyne Borges]

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

[Visitante]

O código abaixo retorna a linha em que for encontrada na coluna A a primeira incidência igual à data existente em M15, se houver uma.

Sub LocalizaData()
 Dim d As Range
  Set d = [A:A].Find([M15])
  MsgBox d.Row
End Sub

Se você não conseguir adaptar então disponibilize um arquivo com exemplos nas planilhas e com os respectivos resultados desejados, acompanhados das necessárias explicações nas próprias planilhas.

[Tatyne Borges]

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... 

[Visitante]

Em 27/08/2019 às 11:31, osvaldomp disse:

 ... disponibilize um arquivo com exemplos nas planilhas e com os respectivos resultados desejados, acompanhados das necessárias explicações nas próprias planilhas.

 

Disponibilize uma amostra do seu arquivo Excel conforme comentei antes, com o código instalado.

Arquivos com macros precisam ser compactados antes de anexar aqui no fórum.

 

Imagens, prints, fotos, capturas, desenhos, ...  de planilhas não servem.

[Tatyne Borges]

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
 

 

 

 

[Visitante]

Segue uma ideia que me parece mais simples: em lugar de buscar um intervalo de datas na planilha destino, depois inserir linha, colar o registro na linha inserida e retificar as fórmulas existentes na coluna N, mantenha o seu código colando na primeira linha vazia e em seguida ordene os dados com base nas datas na coluna A.

Faça um teste e veja se atende.

Acrescente a linha em vermelho, conforme abaixo, ao código que está no arquivo que você postou.

 

                x = x + 1
           .Range("A15:M" & LR).Sort Key1:=.[A14], Order1:=xlAscending

[Tatyne Borges]

 SENSACIONAL 

muito obrigada pela ajuda.