Este fórum está sendo desativado

[DennerSantos]

Galerinha preciso de uma ajuda, nao manjo muito de excel vba mais fiz umas coisas pesquisando na net so que to fazendo uma planilha que puxa lançamento do cartao em uma planilha e joga na outra atraves de um botao quando clicado porem eu queria que ele pegasse esses dados e multiplicasse pelo numero de parcela e colocasse na planilha, sera que é possivel? segue meu codigo

Código: Selecionar todos

Sub relatorio()
    Plan6.Range("A7:i1500").ClearContents
    ultimalinha = Planilha1.Cells(Rows.Count, "a").End(xlUp).Row
    lin = 7
    For i = 2 To ultimalinha
        If Planilha1.Cells(i, 1) = "Saida" Then
        If Planilha1.Cells(i, 2) = "Emprestimo" Then
            Plan6.Cells(lin, 1) = Planilha1.Cells(i, 1) 'Movimento
            Plan6.Cells(lin, 2) = Planilha1.Cells(i, 3) 'Status
            Plan6.Cells(lin, 3) = DateValue(Format(Planilha1.Cells(i, 4), "mm/dd/yyyy")) 'data
            Plan6.Cells(lin, 4) = DateValue(Format(Planilha1.Cells(i, 5), "mm/dd/yyyy")) 'Vencimento
            Plan6.Cells(lin, 5) = Planilha1.Cells(i, 7) 'Pessoa
            Plan6.Cells(lin, 6) = Planilha1.Cells(i, 8) 'Descrição
            Plan6.Cells(lin, 8) = Planilha1.Cells(i, 6) 'Parcela
            Plan6.Cells(lin, 9) = Planilha1.Cells(i, 9) 'Saida
            Plan6.Cells(lin, 12) = Planilha1.Cells(i, 14) 'Resolvido
            lin = lin + 1
           End If
        End If
        
          If Planilha1.Cells(i, 1) = "Recebimento" Then
        If Planilha1.Cells(i, 2) = "Emprestimo" Then
            Plan6.Cells(lin, 1) = Planilha1.Cells(i, 1) 'Movimento
            Plan6.Cells(lin, 2) = Planilha1.Cells(i, 3) 'Status
            Plan6.Cells(lin, 3) = DateValue(Format(Planilha1.Cells(i, 4), "mm/dd/yyyy")) 'data
            Plan6.Cells(lin, 5) = Planilha1.Cells(i, 7) 'Pessoa
            Plan6.Cells(lin, 6) = Planilha1.Cells(i, 8) 'Descrição
            Plan6.Cells(lin, 7) = Planilha1.Cells(i, 9) 'Entrada
            Plan6.Cells(lin, 12) = Planilha1.Cells(i, 14) 'Resolvido
            lin = lin + 1
            End If
        End If
        
    Next
End Sub

um exemplo melhor la lanço

uma compra de R$ 1000,00 e parcela de 6x

e lança na planilha cada parcela no seu dia com mês de vencimento seria muito grato

[osvaldomp]

Olá, @DennerSantos .

Sugestão: disponibilize uma amostra do seu arquivo Excel com alguns exemplos, com o código atual instalado e com o resultado desejado.

[DennerSantos]

Desculpe tinha anexado porem nao subiu segue agora

Teste Planilha.xlsm

[osvaldomp]

Olá, @DennerSantos .

Sugestão: disponibilize uma amostra do seu arquivo Excel com alguns exemplos, com o código atual instalado e com o resultado desejado.

#
Não encontrei o resultado desejado com as necessárias explicações.

[DennerSantos]

vamos ver se eu consigo explicar...

Na planilha A(LANÇAMENTO) eu vou lançar as compras la vou lançar o valor total, vencimento e quantas parcelas e quando eu clicar no botão "lançar" na planilha B(RECEBIMENTO) ele lançar nas linhas abaixo as parcelas uma a uma em cada linha com o vencimento e o valor dividido pela quantidade de parcela

Teste Planilha.xlsm

[osvaldomp]

Confirme se os dados que você colocou na planilha Recebimento representam o resultado desejado.

[DennerSantos]

os dados que estão na planilha recebimento esta puxando exatamente como esta na planilha lançamentos vou colocar em anexo como eu queria que ficasse

Teste Planilha.xlsm

[osvaldomp]

Código: Selecionar todos

Sub ReplicaDados()
 Dim mov As Range, i As Long
  Application.ScreenUpdating = False
  If Sheets("Recebimento").[A7] <> "" Then
   Sheets("Recebimento").Range("A7:I" & Sheets("Recebimento").Cells(Rows.Count, 1).End(3).Row).Value = ""
  End If
  With Sheets("Lançamentos")
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
   .[A6:I6].AutoFilter 1, "Saida"
   If .AutoFilter.Range.Columns(1).SpecialCells(12).Count > 1 Then
    For Each mov In .Range("A7:A" & .Cells(Rows.Count, 1).End(3).Row).SpecialCells(12)
     mov.Resize(, 3).Copy
     Sheets("Recebimento").Cells(Rows.Count, 1).End(3)(2).Resize(mov.Offset(, 4).Value).PasteSpecial xlValues
     mov.Offset(, 5).Resize(, 2).Copy
     Sheets("Recebimento").Cells(Rows.Count, 5).End(3)(2).Resize(mov.Offset(, 4).Value).PasteSpecial xlValues
     mov.Offset(, 3).Copy
     Sheets("Recebimento").Cells(Rows.Count, 4).End(3)(2).PasteSpecial xlValues
     For i = 1 To mov.Offset(, 4).Value
      Sheets("Recebimento").Cells(Rows.Count, 4).End(3)(1 - (i > 1) * 1).Value = DateAdd("m", i - 1, mov.Offset(, 3))
      Sheets("Recebimento").Cells(Rows.Count, 8).End(3)(2).Value = "'" & i & "/" & mov.Offset(, 4).Value
      Sheets("Recebimento").Cells(Rows.Count, 9).End(3)(2).Value = mov.Offset(, 7).Value / mov.Offset(, 4).Value
     Next i
    Next mov
   End If
   .ShowAllData
  End With
End Sub