ERRO EM TEMPO DE EXECUÇÃO "1004"

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 5: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 7: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 7: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 8:21 am