Macro para inserir linha com critério na celula

[Edson Belo Xavier]

Tenho uma planilha que recebi da area comercial com códigos consolidados e preciso multiplicar esses codigos consolidados para as quantidades especificas de loja, onde coloco a quantidade de

lojas no final da linha e queria que inserisse linhas de acordo com essa quantidade informada e assim sucessivamente pra cada linha.

SKU	Descrição	lojas	inserir linhas
1	produto 1	2	inserir 2 lnhas abaixo
2	produto 2	3	inserir 3 lnhas abaixo
3	produto 3	4	inserir 4 lnhas abaixo
4	produto 4	2	inserir 2 lnhas abaixo
5	produto 5	1	inserir 1 lnhas abaixo
6	produto 6	3	inserir 3 lnhas abaixo

 

[Alyson Ronnan Martins]

16 horas atrás, Edson Belo Xavier disse:

Tenho uma planilha que recebi da area comercial com códigos consolidados e preciso multiplicar esses codigos consolidados para as quantidades especificas de loja, onde coloco a quantidade de

lojas no final da linha e queria que inserisse linhas de acordo com essa quantidade informada e assim sucessivamente pra cada linha.

SKU	Descrição	lojas	inserir linhas
1	produto 1	2	inserir 2 lnhas abaixo
2	produto 2	3	inserir 3 lnhas abaixo
3	produto 3	4	inserir 4 lnhas abaixo
4	produto 4	2	inserir 2 lnhas abaixo
5	produto 5	1	inserir 1 lnhas abaixo
6	produto 6	3	inserir 3 lnhas abaixo

 

 

Boa tarde.

Olha se esse código funciona.

Public Sub cmdPularLinhas()
Dim xLinhas As Long
Dim valorAtual As Long
Dim x As Long
xLinhas = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
If xLinhas > 1 Then
    For x = xLinhas To 2 Step -1
        valorAtual = ActiveSheet.Range("C" & x).Value
        Rows(x + 1 & ":" & x + valorAtual).Insert Shift:=xlDown
    Next x
End If
End Sub

 

[Edson Belo Xavier]

2 horas atrás, Alyson Ronnan Martins disse:

 

Boa tarde.

Olha se esse código funciona.

Public Sub cmdPularLinhas()
Dim xLinhas As Long
Dim valorAtual As Long
Dim x As Long
xLinhas = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
If xLinhas > 1 Then
    For x = xLinhas To 2 Step -1
        valorAtual = ActiveSheet.Range("C" & x).Value
        Rows(x + 1 & ":" & x + valorAtual).Insert Shift:=xlDown
    Next x
End If
End Sub

 

Ebaaaa!! Deu certo sim! Obrigado!

 

• Denunciar post
•  
•  

Postado agora

  2 horas atrás, Alyson Ronnan Martins disse:

 

Boa tarde.

Olha se esse código funciona.

Public Sub cmdPularLinhas()
Dim xLinhas As Long
Dim valorAtual As Long
Dim x As Long
xLinhas = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
If xLinhas > 1 Then
    For x = xLinhas To 2 Step -1
        valorAtual = ActiveSheet.Range("C" & x).Value
        Rows(x + 1 & ":" & x + valorAtual).Insert Shift:=xlDown
    Next x
End If
End Sub

 

Ebaaaa!! Deu certo sim! Obrigado!