Traduzir Macro VBA para Office

perguntadas 2020-06-10 15:03:35 +0200

imagem do gravatar de Joao

updated 2020-06-10 15:09:16 +0200

imagem do gravatar de Schiavinatto

Gostaria que um macro que foi desenvolvido no sistema VBA fosse traduzido para que funcionasse do mesmo modo no Office. Existe como fazer essa exigência?

Segue macro abaixo:

Sub Atualizar()
'Macro Atualizar Planilha
'
'Seleciona a célula E18 e inicia a macro
'Caso a célula E18 = "", pula para a próxima célula acima
'Caso não, executa o processo de cópia e logo, pula para a célula acima e continua a macro
'

Sheets("Acompanhamento").Select

ActiveSheet.Unprotect

Sheets("Contagem").Select

Range("J5").Select
Selection.Copy

Sheets("Acompanhamento").Select

Range("K4").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("M3").Select
Sheets("Contagem").Select
Range("K4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Acompanhamento").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("G7").Select
Selection.AutoFilter
Range("E5").Select
Selection.Copy
Range("K5").Select
ActiveSheet.Paste


Range("IU8:IV13500").Select
Selection.Delete Shift:=xlToLeft
Range("J13500").Select 'Seleciona célula de gatilho do macro.


Do While ActiveCell.Row > 1

    If ActiveCell <> "" Then 'Se célula ativa é diferente de vazio
    ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1).Select 'seleciona célula da direita
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'inserir uma célula e mover para direita
    ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column - 2).Select 'retorna para a célula da data
    ActiveCell.Copy 'copia a célula data
    ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 2).Select 'seleciona célula da direita
    Selection.PasteSpecial xlPasteValuesAndNumberFormats
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'inserir uma célula e mover para direita
    ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column - 1).Select 'volta para a célula do PROCV
    ActiveCell.Copy 'copia PROCV
    ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1).Select 'volta para a célula após cópia data
    Selection.PasteSpecial xlPasteValuesAndNumberFormats 'cola PROCV
    ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column - 1).Select 'retorno para a linha principal do macro
    ActiveSheet.Cells(ActiveCell.Row - 1, ActiveCell.Column).Select 'seleciona célula acima

    Else


    ActiveSheet.Cells(ActiveCell.Row - 1, ActiveCell.Column).Select 'seleciona célula acima

    End If


Loop



 Sheets("Contagem").Select
 Range("A1:AA20000").Select
 Selection.ClearContents
 Range("A1").Select
 Sheets("Acompanhamento").Select
 Range("Q3").Select
 Selection.ClearContents
 Range("A1").Select

 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End Sub
editar alterar tag assinalar como ofensivo fechar mesclar Excluir