Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
ERRO EM TEMPO DE EX...
 
Notifications
Clear all

ERRO EM TEMPO DE EXECUÇÃO "1004"

 
2024 - VBA & Macros
Post Recente por Anderson 5 anos atrás
4 Posts
2 Usuários
0 Reactions
891 Visualizações
RSS
 317073
(@317073)
Posts: 2
New Member
Topic starter
 

Boa tarde Galera,

Preciso da ajuda.. Estou com um VBA aonde está apresentando um erro no código "ActiveCell.Offset(1, 0).Range("A1").Select", essa parte já fica no final da Macro, abaixo segue todo o script.

' DADOS PRINCIPAIS

    Range("AV1").Select
    ActiveCell.FormulaR1C1 = "=R2C3"
    Range("AW1").Select
    ActiveCell.FormulaR1C1 = "=R3C3"
    Range("AX1").Select
    ActiveCell.FormulaR1C1 = "=R4C3"
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "=R5C3"
    Range("AZ1").Select
    ActiveCell.FormulaR1C1 = "=R17C15"
    
''TIPO DE VEICULAÇÃO

    Range("AU1").Select
    ActiveCell.FormulaR1C1 = "=R12C3"

'REMOVER CONTE?DO FALSO DA LINHA


    Columns("E:E").Select
    Selection.Find(What:="GRADE DE VEICULA??O FORA DA GRADE", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(-1, -2).Range("A1:Q1").Select
    Selection.ClearContents
'-------------------------

' COPIAR DADOS DENTRO DA GRADE

    Range("C17:S17").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Range("BA1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'-------------------------------------------------------------------
 
 ' REMOVER DUPLICADAS DE DENTRO DA GRADE

    Columns("BA:BO").Select
    ActiveSheet.Range("$BA$1:$BO$3055").RemoveDuplicates Columns:=Array(1, 2, 15), _
        Header:=xlNo
        
'-----------------------------------------------------------


' INSERIR FORMULAS PARA OS DADOS DENTRO DA GRADE

    Range("BC1").Select
    ActiveCell.FormulaR1C1 = "=SUMIFS(C5,C3,RC53,C4,RC54,C17,RC67)"
    Range("BC1").Select
    Selection.AutoFill Destination:=Range("BC1:BC90")

    Range("BD1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS(C6,C3,RC53,C4,RC54,C17,RC67,C18,""<>CORTESIA"",C18,""<>CR?DITO"",C18,""<>COMPENSA??O"")"
    Range("BD1").Select
    Selection.AutoFill Destination:=Range("BD1:BD90")

    Range("BJ1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R10C19=R12C19,SUMIFS(C12,C3,RC53,C4,RC54,C17,RC67)*80%,SUMIFS(C12,C3,RC53,C4,RC54,C17,RC67))"
    Range("BJ1").Select
    Selection.AutoFill Destination:=Range("BJ1:BJ90")

    Range("BK1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R10C19=R12C19,SUMIFS(C13,C3,RC53,C4,RC54,C17,RC67,C[-45],""<>CORTESIA"",C18,""<>CR?DITO"",C18,""<>COMPENSA??O"")*80%,SUMIFS(C13,C3,RC53,C4,RC54,C17,RC67,C[-45],""<>CORTESIA"",C18,""<>CR?DITO"",C18,""<>COMPENSA??O""))"
    Range("BK1").Select
    Selection.AutoFill Destination:=Range("BK1:BK90")
    
    
'-------------------------------------------------------------------
    
' COPIAR O FORA DA GRADE
    
    'Range("C17").Select
    'Selection.End(xlDown).Select
    'ActiveCell.Offset(5, 0).Range("A1:Q1").Select
    'Range(Selection, Selection.End(xlDown)).Select
    'Selection.Copy

    Columns("E:E").Select
    Selection.Find(What:="GRADE DE VEICULA??O FORA DA GRADE", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(3, -2).Range("A1:Q1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy


    Range("BS1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
If Range("BS1") <> "" Then

'---------------------------------------------------------------------
  
  
  ' REMOVER DUPLICATAS DE FORA DA GRADE

    Columns("BS:CH").Select
    ActiveSheet.Range("$BS$1:$CH$3055").RemoveDuplicates Columns:=Array(1, 2, 15, 16 _
        ), Header:=xlNo
    
'-------------------------------------------------------------------


' FORMULAS DE FORA DA GRADE

    Range("BV1").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIFS(C6,C3,RC[-3],C4,RC[-2],C17,RC[11],C18,RC[12])"
    Range("BV1").Select
    Selection.AutoFill Destination:=Range("BV1:BV80"), Type:=xlFillDefault
 
    Range("CC1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R10C19=R12C19,SUMIFS(C13,C3,RC[-10],C4,RC[-9],C17,RC[4],C18,RC[5])*80%,SUMIFS(C13,C3,RC[-10],C4,RC[-9],C17,RC[4],C18,RC[5]))"
    Range("CC1").Select
    Selection.AutoFill Destination:=Range("CC1:CC90"), Type:=xlFillDefault
    

If Range("BA2") = "" Then

    Range("BS1:CH1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Range("BA2").Select
    ActiveSheet.Paste

Else

    Range("BS1:CH1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Range("BA1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste

End If

'----------------------------------------------------------------
    
  ' PUXAR TITULOS AT? O FINAL

    Range("AU1:AZ1").Select
    Selection.AutoFill Destination:=Range("AU1:AZ90"), Type:=xlFillDefault
    Range("AU1:A90").Select

'-------------------------------------------------------------------

' REMOVER DUPLICADAS DOS T?TULOS

    Columns("AU:BP").Select
    ActiveSheet.Range("$AU$1:$BP$3055").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5 _
        , 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Header:=xlNo


'--------------------------------------------------------------------------

' COPIAR PARA PLAN1

    Range("AU1:BP1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Plan1").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    [color=#FF0000][b]ActiveCell.Offset(1, 0).Range("A1").Select[/b][/color]
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            
'-------------------------------------------------------------------

Else



' PUXAR TITULOS AT? O FINAL

    Range("AU1:AZ1").Select
    Selection.AutoFill Destination:=Range("AU1:AZ90"), Type:=xlFillDefault
    Range("AU1:A90").Select

'-------------------------------------------------------------------

' REMOVER DUPLICADAS DOS T?TULOS

    Columns("AU:BP").Select
    ActiveSheet.Range("$AU$1:$BP$3055").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5 _
        , 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22), Header:=xlNo


'--------------------------------------------------------------------------

' COPIAR PARA PLAN1


    Range("AU1:BP1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Plan1").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    [color=#FF0000][b]ActiveCell.Offset(1, 0).Range("A1").Select[/b][/color]
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
               
        
End If

End Sub
 
Postado : 17/03/2020 2:06 pm
 Anderson
(@anderson)
Posts: 203
Reputable Member
 
ActiveCell.Offset(1, 0).Select

Em 90% dos casos em que não se anexa o arquivo, ocorrem mal-entendidos, gerando perda de tempo de ambos os lados.

 
Postado : 17/03/2020 4:27 pm
 317073
(@317073)
Posts: 2
New Member
Topic starter
 

Anderson, bom dia!

Agradeço pela ajuda, mais eu coloquei essa informação mais a macro não entende ai vai para o depurador..

Se você tiver outra ideia e puder compartilhar eu agradeço..

 
Postado : 18/03/2020 4:55 am
 Anderson
(@anderson)
Posts: 203
Reputable Member
 
Sub TESTE()

Range("AU1:BP1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Plan1").Select
'Range("A1").Select
'Selection.End(xlDown).Select
'ActiveCell.Offset(1, 0).Range("A1").Select
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

Em 90% dos casos em que não se anexa o arquivo, ocorrem mal-entendidos, gerando perda de tempo de ambos os lados.

 
Postado : 18/03/2020 5:21 am
Forum Jump:
  Tópico Anterior
Próximo Tópico