Boa tarde, pessoal.
Preciso de uma ajuda com um macro.
Tenho uma aba Base onde trago alguns ítens com quantidade de peças importadas e quantidade de peças nacionais e uma outra aba que preciso alimentar apenas com o nome dos produtos que possuem peças importadas (diferente de zero).
1- Preciso que na aba Aplicacao sejam listadas na coluna B todas os itens (nomes) apresentadas na aba Base, que contenham quantidade de peças importadas (diferente de zero). Lembrando que no restante das colunas da mesma linhas já existem formulas que trarão os demais valores da tabela Base.
2-Preciso que na aba Aplicacao sejam acrescentadas linhas conforme a quantidade de itens (com peças importadas), trazendo as formulas das demais colunas (da mesma linha) para que o cálculo seja mantido quando o macro trouxer os itens listados na coluna B.
3-Preciso que na aba Aplicacao sejam excluídas as linhas que estiverem sobrando na tabela, de forma que a tabela fique toda completa com a quantidade de itens com peças importadas e as formulas envolvidas.
Na planilha já tenho um macro passado por um amigo que adiantou muito o trabalho, porém a mesma não traz as formulas quando a linha é acrescentada e a mesma repete um dos intens quando executamos o macro mais de uma vez.
O link da planilha: http://www.4shared.com/file/AFdtXFgHce/Exemplo_Plan1.html
Macro dentro da aba Aplication:
Sub ListaItensAcrescentaLinhas()
Dim wsB As Worksheet, wsO As Worksheet, rngE As Range
Dim K As Long, rO As Long, rB As Long, m As Long, N As Range
Set wsB = Worksheets("BASE"): Set wsO = Worksheets("APLICACAO")
'rO = wsO.Range("B4:B" & wsO.Range("B4").End(xlDown).Row).Rows.Count - 1
rO = Application.CountIf(wsO.Range("B4:B" & wsO.Range("B4").End(xlDown).Row), "<>TOTAL")
rB = Application.CountIf(wsB.Range("C4:C" & wsB.Range("C4").End(xlDown).Row), ">0") - 1
If rB - rO > 0 Then wsO.Rows(4).Resize(rB - rO).Insert
If rO - rB > 0 Then wsO.Rows(4).Resize(rO - rB).Delete
For Each rngE In wsB.Range("C4:C" & wsB.Range("C4").End(xlDown).Row - 1)
If rngE.Value > 0 Then
wsO.Cells(K + 4, 2) = wsB.Cells(rngE.Row, 1)
wsO.Cells(K + 4, 3).Resize(, 1).Value = wsB.Cells(rngE.Row, 3).Resize(, 3).Value
' wsO.Cells(K + 4, 4).Resize(, 1).Value = "=SEERRO(PROCV(B" & Target.Row & ";'C - EST.+CONS.'!$A$4:$AQ$23;6;FALSO); " - ")"
K = K + 1
End If
Next rngE
End Sub
Postado : 07/03/2016 4:16 pm