Excel acrescentar informação em uma lista

[Paulo Baessa]

Boa tarde,

 

preciso de ajuda no excel, acredito que o que vou pedir seja feito com marcro.

 

Tenho uma lista com 3 mil clientes, que estão um abaixo do outro no excel, só que agora preciso acrescentar um total de 11 informações abaixo de cada cliente, o que deverá deslocar cliente "2" para baixo 11 linhas. Como é algo corriqueiro e gera muito trabalho, preciso de uma ajuda, alguém pode me ajudar, coloquei anexo uma planilha como exemplo.

Ajuda excel.xlsx

Ajuda excel.xlsx

[Eder Neumann]

desconfio que 3mil clientes seja dado suficiente para começar a usar uma base de dados mais confiável que o excel, ainda mais que a planilha passará a ter 33 mil linhas

 

por que não organiza a informação como matriz da seguinte forma:

 

 

em vez de 

adicionado 1 minuto depois

não que eu não queira ajudá-lo, só acho que a entrega das pizzas fica mais rápida se feita de moto em vez de monociclo (se é que você me entende)

[Paulo Baessa]

55 minutos atrás, Eder Neumann disse:

desconfio que 3mil clientes seja dado suficiente para começar a usar uma base de dados mais confiável que o excel, ainda mais que a planilha passará a ter 33 mil linhas

 

por que não organiza a informação como matriz da seguinte forma:

 

 

em vez de 

adicionado 1 minuto depois

não que eu não queira ajudá-lo, só acho que a entrega das pizzas fica mais rápida se feita de moto em vez de monociclo (se é que você me entende)

 

adicionado 2 minutos depois

è que preciso que seja um abaixo do outro, pois será enviado para uma tratativa na matriz, e lá eles pedem que seja colocado dessa forma.  e algumas vezes os "11 valores" podem mudar de cliente para cliente.

[Eder Neumann]

19 minutos atrás, Paulo Baessa disse:

e algumas vezes os "11 valores" podem mudar de cliente para cliente.

nesse caso acho que o preenchimento manual seria o mais seguro...

 

se for tudo igual (eu faria assim pois não sou mestre dos vba) grave uma macro de teclado pro primeiro e repita 3 mil vezes

 

se tiver valores difernetes não vejo outra forma senao o bom e velho estagiário

[Visitante]

1 hora atrás, Paulo Baessa disse:

 .. só que agora preciso acrescentar um total de 11 informações abaixo de cada cliente,  

 

 

Você quer que a macro insira 11 linhas abaixo de cada cliente e mantenha essas 11 linhas vazias para posterior preenchimento ou você quer já inserir nelas os 11 textos que você colocou na planilha ?

[Paulo Baessa]

3 horas atrás, osvaldomp disse:

 

Você quer que a macro insira 11 linhas abaixo de cada cliente e mantenha essas 11 linhas vazias para posterior preenchimento ou você quer já inserir nelas os 11 textos que você colocou na planilha ?

 Preciso que ela insira 11 novas linhas entre os clientes e preencha com o texto .

[Visitante]

 

Ao rodar o código abaixo a planilha base clientes deverá ser a planilha ativa.
 

Sub InsereOnzeLinhas()
 Dim LR As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  [B:B] = "": LR = Cells(Rows.Count, 1).End(3).Row
  [B2] = 1: Range("B2").AutoFill Destination:=Range("B2:B" & LR), Type:=xlFillSeries
  Cells(LR + 1, 2).Resize((LR - 1) * 11) = "=INT((ROW(A1)+10)/11)"
  [E2:E12].Copy Range("A" & LR + 1).Resize(11 * (LR - 1))
  Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Value = Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Value
  Range("A2:B" & Cells(Rows.Count, 2).End(3).Row).Sort Key1:=[B2], Order1:=xlAscending
  [B:B] = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

 

[Paulo Baessa]

Em 16/04/2020 às 21:58, osvaldomp disse:

 

Ao rodar o código abaixo a planilha base clientes deverá ser a planilha ativa.
 

Sub InsereOnzeLinhas()
 Dim LR As Long
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  [B:B] = "": LR = Cells(Rows.Count, 1).End(3).Row
  [B2] = 1: Range("B2").AutoFill Destination:=Range("B2:B" & LR), Type:=xlFillSeries
  Cells(LR + 1, 2).Resize((LR - 1) * 11) = "=INT((ROW(A1)+10)/11)"
  [E2:E12].Copy Range("A" & LR + 1).Resize(11 * (LR - 1))
  Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Value = Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Value
  Range("A2:B" & Cells(Rows.Count, 2).End(3).Row).Sort Key1:=[B2], Order1:=xlAscending
  [B:B] = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

OBRIGADO!! FUNCIONOU!!!