none
Reedição de Macro VBA Excel RRS feed

  • Pergunta

  • Olá a todos.

    Tenho uma macro relativamente simples no meu trabalho. Não fui eu que fiz e ela é bem antiga.

    Sempre funcionou perfeitamente, mas de uns tempos pra cá ela faz cada ação de forma muuuuito lenta.

    Ela tem que fazer o seguinte, copiar o nome do funcionário (escolhido de uma lista pré-definida) e criar números sequenciais a partir do último número que foi criado. A quantidade de números a ser criada deve ser informada pelo usuário.

    Então, se o último número for 8823 (na linha 15), e foi solicitado gerar 5 números para o João Carlos.

    Deverá colar nas linhas acima da linha 15, ficando assim:

    linha 15 = 8826 - data  - João Carlos
    linha 16 = 8825 - data  - João Carlos

    linha 17 = 8824 - data  - João Carlos

    Alguém pode me ajudar, deixando a macro mais rápida, mais limpa e sucinta?

    Obrigada desde já!

    Segue a macro:

    Sub Macro_CRIAR_NUMERO_RI()

    '

    ' Macro_CRIAR_NUMERO_RI Macro

    ' Macro gravada em 3/10/2006 para atribuir número RI

    '

    ' Atalho do teclado: Ctrl+Shift+R

    '

        Range("D11").Select

        ActiveCell.FormulaR1C1 = "=R[4]C[-3]+1"

        Range("F11").Select

        ActiveCell.FormulaR1C1 = "=C[-2]+R[-3]C[-1]-1"

        Range("D11:F11").Select

        Selection.Copy

        Range("D12").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

        Range("F12").Select

        Final = ActiveCell.Value

        Range("D12").Select

        CONTADOR = ActiveCell.Value

        Range("A15").Select


        While ActiveCell.Value < Final

            Rows("15:15").Select

            Application.CutCopyMode = False

            Selection.Insert Shift:=xlDown

            Range("A15").Select

            ActiveCell.Value = CONTADOR

            Range("B8:C8").Select

            Selection.Copy

            Range("B15").Select

                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

                    :=False, Transpose:=False

            Range("A15:C15").Select

            Application.CutCopyMode = False

            Selection.Copy

                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

                :=False, Transpose:=False

            Range("b15").Select

            Application.CutCopyMode = False

            Selection.NumberFormat = "dd/mm/yy;@"

            CONTADOR = CONTADOR + 1

            Range("A15").Select

        Wend

            Range("D12:F12").Select

            Selection.ClearContents

            Range("A1").Select

    'Protege e salva a planilha

    'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

            ActiveWorkbook.Save

                MsgBox "OS NÚMEROS DE RIs FORAM SALVOS PARA ESTE INSPETOR, EXCLUSIVAMENTE."


    End Sub

    sexta-feira, 25 de outubro de 2019 22:56