Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Macro Lança valores...
 
Notifications
Clear all

Macro Lança valores em diversas abas

 
2024 - VBA & Macros
2 Posts
2 Usuários
0 Reactions
1,051 Visualizações
RSS
 davi23
(@davi23)
Posts: 0
New Member
Topic starter
 

Senhores colegas, boa tarde.

Estou elaborando uma planilha para controle financeiro.

Porém, quando eu efetuar um lançamento de uma compra parcelada, gostaria de que o valor de cada parcela aparecesse nas abas correspondentes.

A planilha possui a aba "Lançamento", onde eu aponto o tipo do lançamento (Crédito, débito), data, valor e descrição. Ela reconhece a data, extrai o mês e busca em cada aba a planilha onde contém o mês referência.

Dúvida: Como faço para apontar nos meses seguintes as parcelas de acordo com o número de vezes.

Entendo que a variável a considerar é o número de parcelas "np", só não consigo elaborar um procedimento que realize isso.

Estou enviando a planilha para análise.

Caso eu não tenha conseguido me expressar corretamente, peço que me questionem.

Não reparem no meu código, pois estou começando agora e tenho certeza que há maneiras melhores de escrever a minha rotina.
Fiquem a vontade para opinarem e dar sugestões.

Muito Obrigado e boa tarde a todos

Davi Soares

 
Postado : 14/01/2015 11:52 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde Davi,

Cara, resolvi o seu problema... mas não é tão simples assim...
Se chegar no mês de junho e tiver 10 parcelas? Vai para 2016.

Você não pode limitar as planilhas.
Eu preferia fazer como um banco de dados e uma geral onde seleciona o mês e é buscado os valores.

Utiliza isso:

Option Explicit

Sub Processar()
Dim i           As Integer
Dim nParcela    As Integer
Dim UltL        As Long
Dim wsLanc      As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlManual
Set wsLanc = ThisWorkbook.Worksheets("Lançamento")

nParcela = wsLanc.Range("F3").Value

    wsLanc.Range("B3:G3").Copy

    For i = Month(wsLanc.Range("B3").Value) To nParcela
        UltL = ThisWorkbook.Worksheets(i + 1).Range("A" & Rows.Count).End(xlUp).Row + 1
        ThisWorkbook.Worksheets(i + 1).Range("A" & UltL).PasteSpecial Paste:=xlPasteValues
    Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Segue anexo funcionando também.

Qualquer coisa da o grito.
Abraç

 
Postado : 14/01/2015 1:38 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico