Guru do Excel e Power BI

Boa tarde, estou na criação da planiha
tem um codigo que copia uma linha na Planilha Orçamentos ( 3 Operadores) e joga na Planilha ED 3 linhas com a palavra Operadores.
Sub ReplicaDados()
Dim c As Range
Sheets("Planilha_Ed").[A:O] = ""
For Each c In Range("A5:A" & Cells(Rows.Count, 1).End(3).Row)
Sheets("Planilha_Ed").Cells(Rows.Count, 1).End(3)(2).Resize(c.Value, 14) = c.Offset(, 1).Resize(, 14).Value
Next c
Call PlanilhaEd


End Sub

O que acontece é que se for lançado apenas PESSOAL ele funciona legal. Mas quando existe o cabeçalho EQUIPAMENTOS ela para e da erro de execução 1004

Precisave que o codigo copie (agora não precisa separar em lihas) EX: 2 Aja KIPro vou copiar exatamente em 1 linha 2 Aja KIPro e não duas linhas como faz o codigo acima.


Alguém poderia me auxiliar por favor.

Boas tente com este código e veja se é o que pretende:

Obrigado Afonso, porem minhas linhas são variaveis e a sua variavel ultima esta dando nao declarada.

obrigado

AfonsoMira escreveu:Boas tente com este código e veja se é o que pretende:

Código: Selecionar todos

Sub ReplicaDados()

Application.ScreenUpdating = False

Sheets("Planilha_Ed").[A:O] = ""
ultima = Sheets("Orçamento").Range("A9").End(xlUp).Row
 For i = 5 To ultima
    For j = 1 To Cells(i, 1).Value
    Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
    Worksheets("Planilha_Ed").Range("A" & j).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Next j
 Next i
 

 ultima = Sheets("Orçamento").Range("A10000").End(xlUp).Row
 For i = 11 To ultima
    Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
    Worksheets("Planilha_Ed").Range("A" & j).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    j = j + 1
 Next i
 
 
   Call PlanilhaEd
  
  Application.ScreenUpdating = True
  
End Sub

Experimente assim:

Boa noite, e obrigado.
ate aqui
Application.ScreenUpdating = False

Sheets("Planilha_Ed").[A:O] = ""
Dim ultima As Long
Dim i As Long
Dim j As Long

ultima = Sheets("Orçamento").Range("A5").End(xlDown).Row
For i = 5 To ultima
For j = 1 To Cells(i, 1).Value
Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
Worksheets("Planilha_Ed").Range("A" & j).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next j
Next i

Funciona legal porque sempre vou iniciar da celula A5 na primeira parte (por isso adaptei o seu codigo para **
ultima = Sheets("Orçamento").Range("A5").End(xlDown).Row
a segunda parte complica pois pode tanto começar em A11 como em A30.
Pensei no seguinte (mas não consegui fazer ainda rsrsrs)
Ir para A 100000, subir ate encontrar a palavra "QTDE" e descer uma linha.
Pode me ajudar novamente por favor. (se isso for possivel de ser feito)

Grato,

AfonsoMira escreveu:Experimente assim:

Código: Selecionar todos

Sub ReplicaDados()

Application.ScreenUpdating = False
Dim ultima as long
Sheets("Planilha_Ed").[A:O] = ""
ultima = Sheets("Orçamento").Range("A9").End(xlUp).Row
 For i = 5 To ultima
    For j = 1 To Cells(i, 1).Value
    Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
    Worksheets("Planilha_Ed").Range("A" & j).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Next j
 Next i
 

 ultima = Sheets("Orçamento").Range("A10000").End(xlUp).Row
 For i = 11 To ultima
    Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
    Worksheets("Planilha_Ed").Range("A" & j).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    j = j + 1
 Next i
 
 
   Call PlanilhaEd
 
  Application.ScreenUpdating = True
 
End Sub

Boas esta parte do código é para descobrir a ultima linha a ser utilizada: Ele seleciona A1000 e vai para cima até encontrar valor.

Depois vem a parte do código : Ele vai fazer um loop da linha 11 até a ultima que declaramos acima.

Ou seja para alterar a linha onde vai começar o código, basta alterar o número 11 para o valor da linha desejado.

Por exemplo quer começar na linha 13, escreve : .

Penso que me consegui explicar, caso tenha dúvidas por favor avisar.

Bom dia! Afonso. Eu entendi o seu codigo,(que por sinal esta ótimo) acho que eu não consegui me expressar corretamente, esta planilha é de orçamentos e por isso não tem uma linha certa para começar a segunda parte. Vou anexar novamente uma nova planilha para ver se consigo explicar melhor.

AfonsoMira escreveu:Boas esta parte do código é para descobrir a ultima linha a ser utilizada:

Código: Selecionar todos

ultima = Sheets("Orçamento").Range("A1000").End(xlDown).Row

Ele seleciona A1000 e vai para cima até encontrar valor.

Depois vem a parte do código :

Código: Selecionar todos

For i = 11 to ultima

Ele vai fazer um loop da linha 11 até a ultima que declaramos acima.

Ou seja para alterar a linha onde vai começar o código, basta alterar o número 11 para o valor da linha desejado.

Por exemplo quer começar na linha 13, escreve :

Código: Selecionar todos

For i = 13 to ultima

.

Penso que me consegui explicar, caso tenha dúvidas por favor avisar.

Experimente com esta macro: Se precisar de ajudar para entender o código, é só me chamar.

PERFEITO!!!!!!!

De coração , lhe agradeço enormemente.

estava tentando usar o FIND mas o seu ficou muito melhor.

AfonsoMira escreveu:Experimente com esta macro:

Código: Selecionar todos

Sub ReplicaDados()

Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

Sheets("Planilha_Ed").[A:O] = ""
Dim i, j, f, primeira,  ultima_colar, ultima  As Long

    f = 100
    Do Until Cells(f, 1) = "Qtde"
    f = f - 1
    Loop
    
ultima = Sheets("Orçamento").Cells(f - 1, 1).End(xlUp).Row
 For i = 5 To ultima
    For j = 1 To Cells(i, 1).Value
    ultima_colar = Sheets("Planilha_Ed").Range("A10000").End(xlUp).Row
    If ultima_colar >= 1 And i > 5 Then
    ultima_colar = ultima_colar + 1
    End If
    
    Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
    Worksheets("Planilha_Ed").Range("A" & ultima_colar).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Next j
 Next i
 
primeira = f + 1
 ultima = Sheets("Orçamento").Range("A10000").End(xlUp).Row
 For i = primeira To ultima
     ultima_colar = Sheets("Planilha_Ed").Range("A10000").End(xlUp).Row
    If ultima_colar >= 1 And i > 5 Then
    ultima_colar = ultima_colar + 1
    End If
    Worksheets("Orçamento").Range("A" & i & ":O" & i).Copy
    Worksheets("Planilha_Ed").Range("A" & ultima_colar).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    j = j + 1
 Next i
 
 
   Call PlanilhaEd
   
    Application.Calculation = xlCalculationAutomatic
   
   Application.EnableEvents = True
 
  Application.ScreenUpdating = True
  
     MsgBox "Macro terminou", vbOKOnly
  
End Sub

Se precisar de ajudar para entender o código, é só me chamar.