Compartilhar via

Erro de Tempo na execução "1004" o método Copy da classe GroupObject falhou

Anônima
2023-07-06T18:45:59+00:00

Tenho uma planilha em excel com vba para atualização de diagrama, ela rodava bem no 2016 ai migrei pro 365 e ela fica dando erro de tempo na execução

Alguem pode me ajudar?

Sub Cria_Diagrama() 

Application.ScreenUpdating = False 

Application.Calculation = xlCalculationManual 

Apagar\_Diagrama 

j = 3   'Coluna inicial 

i = 13  'Coluna inicial 

Sheet\_Ativa = ActiveSheet.Name   'Guarda o nome da Sheet de trabalho

'Defini a cor da Atividade 

A\_Executar = Range("A\_Executar").Interior.Color 

ESCAVAÇÃO = Range("ESCAVAÇÃO").Interior.Color 

concluido = Range("concluido").Interior.Color 

NIVELAMENTO = Range("NIVELAMENTO").Interior.Color 

CONCRETO = Range("CONCRETO").Interior.Color 

PREMONTAGEM = Range("Pre\_Montagem").Interior.Color 

AGUA = Range("AGUA").Interior.Color 

ROCHA = Range("ROCHA").Interior.Color

'Defini a cor da Torre 

ActiveSheet.Shapes.Range(Array("F\_Concluida")).Select 

F\_Concluida = Selection.Interior.Color 

'ActiveSheet.Shapes.Range(Array("T\_Solo")).Select 

'T\_Solo = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("T\_Montada")).Select 

montagem = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("T\_Revisada")).Select 

T\_revisao = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("T\_Lançada")).Select 

teste = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("T\_Grampeada")).Select 

grampeacao = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("Revisada")).Select 

revisao = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("T\_Comissionada")).Select 

comissionada = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("MED\_RESISTENCIA\_S")).Select 

mediçãoAprovada = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("MED\_RESISTENCIA\_N")).Select 

mediçãoReprovada = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("T\_Entregue")).Select 

TorreEntregue = Selection.Interior.Color

'Defini a cor do Embargo / Impedimento 

ActiveSheet.Shapes.Range(Array("LIBERADA")).Select 

liberada = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("EMBARGO")).Select 

EMBARGO = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("EMBARGO")).Select 

impedida = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("Impedimento/Embargo")).Select 

EMBARGO2 = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("arqueologia")).Select 

ARQUEOLOGIA = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("travessia")).Select 

TRAVESSIA = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("POSSE")).Select 

AERODROMO = Selection.Interior.Color 

ActiveSheet.Shapes.Range(Array("ERRO")).Select 

indefinido = Selection.Interior.Color

Loop1: 

For j = j To 34 'Final da coluna 

    Torre = Cells(i, j).Value 

    If Torre = "" Or Torre = 0 Then 

        MsgBox "Diagrama atualizado com Sucesso. " & Torre 

        Exit Sub 

    End If 

    Tipo\_Torre = Cells(i, j).Offset(1, 0).Value 

'Verifica se é Estaiada e Inclui a Torre 

    If Tipo\_Torre = "N51CRB" Or Tipo\_Torre = "N51CR" Then 

        ActiveSheet.Shapes.Range(Array("Estaiada")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -4 

        Selection.ShapeRange.IncrementLeft 6 

        Selection.ShapeRange.Name = Cells(i, j).Value 

        Atualiza\_Diagrama 

 'Inclui a instalação do contrapeso 

  If Application.VLookup(Torre, Range("produção"), (Range("MED\_RESISTENCIA").Column) - 1, FALSO) = "S" Then 

        ActiveSheet.Shapes.Range(Array("MED\_RESISTENCIA\_S")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -16 

        Selection.ShapeRange.IncrementLeft 10 

        Selection.ShapeRange.Name = "CONTRA\_PESO-" & Cells(i, j).Value 

  ElseIf Application.VLookup(Torre, Range("produção"), (Range("MED\_RESISTENCIA").Column) - 1, FALSO) = "N" Then 

        ActiveSheet.Shapes.Range(Array("MED\_RESISTENCIA\_N")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -16 

        Selection.ShapeRange.IncrementLeft 10 

        Selection.ShapeRange.Name = "CONTRA\_PESO-" & Cells(i, j).Value 

  ElseIf Application.VLookup(Torre, Range("produção"), (Range("CONTRAPESO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("CONTRA\_PESO")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -16 

        Selection.ShapeRange.IncrementLeft 10 

        Selection.ShapeRange.Name = "CONTRA\_PESO-" & Cells(i, j).Value 

  End If 

 'Inclui a definição da montagem manual 

 If Application.VLookup(Torre, Range("produção"), (Range("DEFINIR\_MONTAGEM\_MANUAL").Column) - 1, FALSO) = "ok" Then 

        ActiveSheet.Shapes.Range(Array("MONTAGEM\_MANUAL")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 103 

        Selection.ShapeRange.IncrementLeft 8 

        Selection.ShapeRange.Name = "MONTAGEM\_MANUAL-" & Cells(i, j).Value 

  End If 

 'Inclui premontagem e içamento 

 If Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA\_FACÃO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("ESTAIADA\_IÇADA")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 73 

        Selection.ShapeRange.IncrementLeft 12 

        Selection.ShapeRange.Name = "ESTAIADA\_IÇADA-" & Cells(i, j).Value 

   ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA\_GUINDASTE").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("ESTAIADA\_IÇADA")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 73 

        Selection.ShapeRange.IncrementLeft 12 

        Selection.ShapeRange.Name = "ESTAIADA\_IÇADA-" & Cells(i, j).Value 

   ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA\_NO\_CHÃO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("ESTAIADA\_NO\_CHÃO")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 76 

        Selection.ShapeRange.IncrementLeft -1 

        Selection.ShapeRange.Name = "ESTAIADA\_NO\_CHÃO-" & Cells(i, j).Value 

   ElseIf Application.VLookup(Torre, Range("produção"), (Range("T\_Transportada").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("T\_Transportada")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 76 

        Selection.ShapeRange.IncrementLeft -1 

        Selection.ShapeRange.Name = "T\_Transportada-" & Cells(i, j).Value 

   ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA\_GUINDASTE").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("ESTAIADA\_IÇADA")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 73 

        Selection.ShapeRange.IncrementLeft 12 

        Selection.ShapeRange.Name = "ESTAIADA\_IÇADA-" & Cells(i, j).Value 

  End If 

      'Inclui Condutor Lançado e Grampeado 

 If Application.VLookup(Torre, Range("produção"), (Range("CONDUTOR\_GRAMPEADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("CondutorGrampeado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 46 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "CondutorGrampeado-" & Cells(i, j).Value 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("CONDUTOR\_LANÇADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("CondutorLançado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 46 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "CondutorLançado-" & Cells(i, j).Value 

 End If

'Inclui Pára-Raios Lançado e Grampeado 

 If Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_1\_GRAMPEADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios1Grampeado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 79.5 

        Selection.ShapeRange.IncrementLeft 34 

        Selection.ShapeRange.Name = "PáraRaios1Grampeado-" & Cells(i, j).Value 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_1\_LANÇADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios1Lançado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 79.5 

        Selection.ShapeRange.IncrementLeft 34 

        Selection.ShapeRange.Name = "PáraRaios1Lançado-" & Cells(i, j).Value 

 End If 

      'Inclui Fibra Óptica Lançado e Grampeado 

 If Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_2\_GRAMPEADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios2Grampeado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 40 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "PáraRaios2Grampeado-" & Cells(i, j).Value 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_2\_LANÇADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios2Lançado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 40 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "PáraRaios2Lançado-" & Cells(i, j).Value 

 End If

'apaga a definição de montagem manual 

 If Application.VLookup(Torre, Range("produção"), (Range("DEFINIR\_MONTAGEM\_MANUAL").Column) - 1, FALSO) = "ok" Then 

 If Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA\_FACÃO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("MONTAGEM\_MANUAL-" & Torre)).Delete 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA\_GUINDASTE").Column) - 1, FALSO) > 1 Then 

      ActiveSheet.Shapes.Range(Array("MONTAGEM\_MANUAL-" & Torre)).Delete 

  End If 

  End If 

'Faz a inclusão do Impedimento 

    If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) <> "L" Then 

     If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "I" Then 

        ActiveSheet.Shapes.Range(Array("impedimento")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -9.5 

        Selection.ShapeRange.IncrementLeft 0 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "EI" Then 

        ActiveSheet.Shapes.Range(Array("Impedimento/Embargo")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -9.5 

        Selection.ShapeRange.IncrementLeft 0 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "A" Then 

        ActiveSheet.Shapes.Range(Array("arqueologia")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -9.5 

        Selection.ShapeRange.IncrementLeft 0 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "T" Then 

        ActiveSheet.Shapes.Range(Array("travessia")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -9.5 

        Selection.ShapeRange.IncrementLeft 0 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "P" Then 

        ActiveSheet.Shapes.Range(Array("posse")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -9.5 

        Selection.ShapeRange.IncrementLeft 0 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "F" Then 

        ActiveSheet.Shapes.Range(Array("NEGOCIACAO")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -9.5 

        Selection.ShapeRange.IncrementLeft 0 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

     End If 

     End If 

'Verifica se é Auto Portante e Inclui a Torre 

     ElseIf Tipo\_Torre = "N51SL" Or Tipo\_Torre = "N51SM" Or Tipo\_Torre = "N51SP" Or Tipo\_Torre = "N51AE" Or Tipo\_Torre = "N51A1" Or Tipo\_Torre = "N51A2" Or Tipo\_Torre = "N51AT" Or Tipo\_Torre = "N51TR" Or Tipo\_Torre = "N51TV" Or Tipo\_Torre = "PORT" Then 

        ActiveSheet.Shapes.Range(Array("Auto Portante")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementLeft 6 

        Selection.ShapeRange.Name = Cells(i, j).Value 

        Atualiza\_Diagrama 

 'Inclui a instalação do contrapeso 

  If Application.VLookup(Torre, Range("produção"), (Range("MED\_RESISTENCIA").Column) - 1, FALSO) = "S" Then 

        ActiveSheet.Shapes.Range(Array("MED\_RESISTENCIA\_S")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -16 

        Selection.ShapeRange.IncrementLeft 10 

        Selection.ShapeRange.Name = "CONTRA\_PESO-" & Cells(i, j).Value 

  ElseIf Application.VLookup(Torre, Range("produção"), (Range("MED\_RESISTENCIA").Column) - 1, FALSO) = "N" Then 

        ActiveSheet.Shapes.Range(Array("MED\_RESISTENCIA\_N")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -16 

        Selection.ShapeRange.IncrementLeft 10 

        Selection.ShapeRange.Name = "CONTRA\_PESO-" & Cells(i, j).Value 

  ElseIf Application.VLookup(Torre, Range("produção"), (Range("CONTRAPESO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("CONTRA\_PESO")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -16 

        Selection.ShapeRange.IncrementLeft 10 

        Selection.ShapeRange.Name = "CONTRA\_PESO-" & Cells(i, j).Value 

  End If 

     'Inclui a definição da montagem manual 

 If Application.VLookup(Torre, Range("produção"), (Range("DEFINIR\_MONTAGEM\_MANUAL").Column) - 1, FALSO) = "ok" Then 

        ActiveSheet.Shapes.Range(Array("MONTAGEM\_MANUAL")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 103 

        Selection.ShapeRange.IncrementLeft 8 

        Selection.ShapeRange.Name = "MONTAGEM\_MANUAL-" & Cells(i, j).Value 

  End If 

  'Inclui premontagem e montagem auto portante 

 If Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE\_MONTADA").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("AUTOPORTANTE\_EM\_PÉ")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 76 

        Selection.ShapeRange.IncrementLeft 12 

        Selection.ShapeRange.Name = "AUTOPORTANTE\_EM\_PÉ-" & Cells(i, j).Value 

   ElseIf Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE\_PREMONTADA").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("AUTOPORTANTE\_NO\_CHÃO")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 76 

        Selection.ShapeRange.IncrementLeft -1 

        Selection.ShapeRange.Name = "AUTOPORTANTE\_NO\_CHÃO-" & Cells(i, j).Value 

  End If 

      'Inclui Condutor Lançado e Grampeado 

 If Application.VLookup(Torre, Range("produção"), (Range("CONDUTOR\_GRAMPEADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("CondutorGrampeado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 46 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "CondutorGrampeado-" & Cells(i, j).Value 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("CONDUTOR\_LANÇADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("CondutorLançado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 46 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "CondutorLançado-" & Cells(i, j).Value 

 End If

'Inclui Pára-Raios Lançado e Grampeado 

 If Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_1\_GRAMPEADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios1Grampeado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 79.5 

        Selection.ShapeRange.IncrementLeft 34 

        Selection.ShapeRange.Name = "PáraRaios1Grampeado-" & Cells(i, j).Value 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_1\_LANÇADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios1Lançado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 79.5 

        Selection.ShapeRange.IncrementLeft 34 

        Selection.ShapeRange.Name = "PáraRaios1Lançado-" & Cells(i, j).Value 

 End If 

      'Inclui Fibra Óptica Lançado e Grampeado 

 If Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_2\_GRAMPEADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios2Grampeado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 40 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "PáraRaios2Grampeado-" & Cells(i, j).Value 

 ElseIf Application.VLookup(Torre, Range("produção"), (Range("PÁRA\_RAIOS\_2\_LANÇADO").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("PáraRaios2Lançado")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop 40 

        Selection.ShapeRange.IncrementLeft 26 

        Selection.ShapeRange.Name = "PáraRaios2Lançado-" & Cells(i, j).Value 

 End If

'apaga a definição de montagem manual 

 If Application.VLookup(Torre, Range("produção"), (Range("DEFINIR\_MONTAGEM\_MANUAL").Column) - 1, FALSO) = "ok" Then 

 If Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE\_MONTADA").Column) - 1, FALSO) > 1 Then 

        ActiveSheet.Shapes.Range(Array("MONTAGEM\_MANUAL-" & Torre)).Delete 

  End If 

  End If 

   'Faz a inclusão do Impedimento 

    If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) <> "L" Then 

     If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "I" Then 

        ActiveSheet.Shapes.Range(Array("impedimento")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -8 

        Selection.ShapeRange.IncrementLeft 1 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "EI" Then 

        ActiveSheet.Shapes.Range(Array("Impedimento/Embargo")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -8 

        Selection.ShapeRange.IncrementLeft 1 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "A" Then 

        ActiveSheet.Shapes.Range(Array("arqueologia")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -8 

        Selection.ShapeRange.IncrementLeft 1 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "T" Then 

        ActiveSheet.Shapes.Range(Array("travessia")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -8 

        Selection.ShapeRange.IncrementLeft 1 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "AE" Then 

        ActiveSheet.Shapes.Range(Array("aerodromo")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -8 

        Selection.ShapeRange.IncrementLeft 1 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

      ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "P" Then 

        ActiveSheet.Shapes.Range(Array("POSSE")).Select 

        Selection.Copy 

        Cells(i, j).Offset(-3, 0).Select 

        ActiveSheet.Paste 

        Selection.ShapeRange.IncrementTop -8 

        Selection.ShapeRange.IncrementLeft 1 

        Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value 

     End If 

     End If 

    End If

Next j

'Esta função abaixo é para quando terminar o laço For, ai ele analisa e reinicia o laço com os criterios abaixo da Função IF

If Cells(i, j - 1).Value <> 0 And Cells(i + 7, 3).Value <> 0 Then 'Final da tabela 

    i = i + 7 

    j = 3 

    GoTo Loop1 

Exit Sub 

End If 

Application.ScreenUpdating = True 

Application.Calculation = xlCalculationAutomatic
Microsoft 365 e Office | Excel | Para uso doméstico | Windows

Pergunta bloqueada. Essa pergunta foi migrada da Comunidade de Suporte da Microsoft. É possível votar se é útil, mas não é possível adicionar comentários ou respostas ou seguir a pergunta.

0 comentários

1 resposta

Classificar por: Mais útil
Mais útil Mais Novo Mais Antigo
  1. Anônima
    2023-07-07T02:13:44+00:00

    Esta resposta foi traduzida automaticamente. Como resultado, pode haver erros gramaticais ou palavras estranhas.

    Olá DehJuh

    Obrigado por postar na Microsoft Community.

    Entendemos que isso é importante para você cumprir, e examinamos essa preocupação muito de perto e até investimos meus colegas nela. Acho que nossa equipe chegou ao seu limite e está além do nosso conhecimento. Não queremos deixá-lo em branco aqui, por isso gostaríamos de sugerir que você consulte o melhor lugar para obter ajuda para Macro e outros programas para uso avançado do Excel, Microsoft Q&A, o especialista técnico em lidar com tais preocupações, visa apoiar usuários mais avançados como você. Poste também a mesma preocupação na seção de perguntas e respostas da Microsoft clicando no link "Introdução às perguntas e respostas": Produtos suportados pela Microsoft nas perguntas e respostas | Aprenda com a Microsoft

    Nota: Que este é um site em inglês, altere a localidade rolando para baixo na parte inferior da página.

    Espero que entendam.

    Relação

    Jasão Guer

    Moderador da Comunidade Microsoft

    Esta resposta foi útil?

    0 comentários