Macro Para Pesquisa

Anônima
2019-02-27T01:09:33+00:00

Prezados.

É com satisfação que volta a esse Comunity para solicitar ajuda.

Verdade que estou iniciando na utilização de macros aplicada diretamente no Excel e por isso pode até parecer um tanto infantil (não para mim).

Estou desenvolvendo uma planilha que deverá conter os dados dos meus projetos de pesquisa e nessa planilha, pretendo cadastrar meus projetos de pesquisa, os elementos da pesquisa como, por exemplo, os dados bibliográfico das fontes de pesquisa (planilha em separado), os dados básicos da pesquisa (por exemplo: artigos, teses, dissertações etc. - também em planilha separada para cada elementos) e assim por diante.

Desenvolvi a macro abaixo, porém está dando um erro "básico" que não sei como resolver.

Ocorre que, após lançado os dados na planilha CADASTRAR PROJETOS, os dados deverão ser salvo na planilha CADASTRO DOS PROJETOS.

O próximo evento deve ser gravados em linha separada, preservando os dados já gravados.

O que ocorre é que os dados gravados são sobrepostos e, com isso, perco os dados gravados anteriormente.

Segue a linha de código da macro e com isso, solicito ajuda pois, não consigo ver onde posso ajustar os comandos.

Desde já, agradeço a todos.

Sub CAD_PROJ()

'

' CAD_PROJ Macro

' Cadastra projetos de qualquer natureza

'

'

    Sheets("CADASTRAR PROJETOS").Select

    Range("D6").Select

    Selection.Copy

    'ActiveSheet.Next.Select

    Sheets("CADASTRO DOS PROJETOS").Select

    Range("Tabela16[[#Headers],[COD]]").Select

    Selection.End(xlDown).Select

    Selection.End(xlUp).Select

    ActiveCell.Offset(1, 0).Select

    Range("Tabela16[ABREV]").Select

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

        :=False, Transpose:=False

    Range("Tabela16[TÍTULO]").Select

    ActiveSheet.Previous.Select

    Range("E8").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    ActiveSheet.Previous.Select

    Range("D10").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

    Range("Tabela16[INÍCIO]").Select

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

        :=False, Transpose:=False

    Range("Tabela16[TÉRMINO]").Select

    ActiveSheet.Previous.Select

    Range("D12").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[TEMÁTICA]").Select

    ActiveSheet.Previous.Select

    Range("E14").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[TEMA]").Select

    ActiveSheet.Previous.Select

    Range("E16").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PESQUISADOR]").Select

    ActiveSheet.Previous.Select

    ActiveWindow.SmallScroll Down:=12

    Range("E21").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[COPESQUISADOR]").Select

    ActiveSheet.Previous.Select

    Range("E23").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[DISCENTE PESQUISADOR]").Select

    ActiveSheet.Previous.Select

    Range("E25").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[TÉCNICO]").Select

    ActiveSheet.Previous.Select

    Range("E27").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA DE PESQUISA]").Select

    ActiveSheet.Previous.Select

    ActiveWindow.SmallScroll Down:=15

    Range("E32").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[HIPÓTESE 1]").Select

    ActiveSheet.Previous.Select

    Range("E34").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[HIPÓTESE 2]").Select

    ActiveSheet.Previous.Select

    Range("E36").Select

    ActiveWindow.SmallScroll Down:=6

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[HIPÓTESE 3]").Select

    ActiveSheet.Previous.Select

    Range("E38").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[HIPÓTESE 4]").Select

    ActiveSheet.Previous.Select

    Range("E40").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[HIPÓTESE 5]").Select

    ActiveSheet.Previous.Select

    Range("E42").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 1]").Select

    ActiveSheet.Previous.Select

    ActiveWindow.SmallScroll Down:=12

    Range("E47").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 2]").Select

    ActiveSheet.Previous.Select

    Range("E49").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 3]").Select

    ActiveSheet.Previous.Select

    Range("E51").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 4]").Select

    ActiveSheet.Previous.Select

    Range("E53").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 5]").Select

    ActiveSheet.Previous.Select

    ActiveWindow.SmallScroll Down:=9

    Range("E55").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 6]").Select

    ActiveSheet.Previous.Select

    Range("E57").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 7]").Select

    ActiveSheet.Previous.Select

    Range("E59").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 8]").Select

    ActiveSheet.Previous.Select

    Range("E61").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 9]").Select

    ActiveSheet.Previous.Select

    ActiveWindow.SmallScroll Down:=6

    Range("E63").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[PERGUNTA NORTEADORA 10]").Select

    ActiveSheet.Previous.Select

    Range("E65").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[OBJETIVO GERAL]").Select

    ActiveSheet.Previous.Select

    ActiveWindow.SmallScroll Down:=6

    Range("E70").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[OBJETIVO ESPECÍFICO 1]").Select

    ActiveSheet.Previous.Select

    Range("E72").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[OBJETIVO ESPECÍFICO 2]").Select

    ActiveSheet.Previous.Select

    Range("E74").Select

    ActiveWindow.SmallScroll Down:=6

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[OBJETIVO ESPECÍFICO 3]").Select

    ActiveSheet.Previous.Select

    Range("E76").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[OBJETIVO ESPECÍFICO 4]").Select

    ActiveSheet.Previous.Select

    Range("E78").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    Range("Tabela16[OBJETIVO ESPECÍFICO 5]").Select

    ActiveSheet.Previous.Select

    Range("E80").Select

    Application.CutCopyMode = False

    Selection.Copy

    ActiveSheet.Next.Select

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

        :=False, Transpose:=False

    ActiveSheet.Previous.Select

    Range("E80").Select

    Application.CutCopyMode = False

    Selection.ClearContents

    Range("E78").Select

    Selection.ClearContents

    Range("E76").Select

    Selection.ClearContents

    Range("E74").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-9

    Range("E72").Select

    Selection.ClearContents

    Range("E70").Select

    Selection.ClearContents

    Range("E65").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-3

    Range("E63").Select

    Selection.ClearContents

    Range("E61").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-6

    Range("E59").Select

    Selection.ClearContents

    Range("E57").Select

    Selection.ClearContents

    Range("E55").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-9

    Range("E53").Select

    Selection.ClearContents

    Range("E51").Select

    Selection.ClearContents

    Range("E49").Select

    Selection.ClearContents

    Range("E47").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-12

    Range("E42").Select

    Selection.ClearContents

    Range("E40").Select

    Selection.ClearContents

    Range("E38").Select

    Selection.ClearContents

    Range("E36").Select

    Selection.ClearContents

    Range("E34").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-9

    Range("E32").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-6

    Range("E27").Select

    Selection.ClearContents

    Range("E25").Select

    Selection.ClearContents

    Range("E23").Select

    Selection.ClearContents

    Range("E21").Select

    Selection.ClearContents

    ActiveWindow.SmallScroll Down:=-18

    Range("E16").Select

    Selection.ClearContents

    Range("E14").Select

    Selection.ClearContents

    Range("D12").Select

    Selection.ClearContents

    Range("D10").Select

    Selection.ClearContents

    Range("E8").Select

    Selection.ClearContents

    Range("D6").Select

    Selection.ClearContents

End Sub

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

Resposta aceita pelo autor da pergunta

Anônima
2019-03-07T16:25:39+00:00

Olá Geazi,

Olhando para o código, observa-se muita redundância, pois muitos dos comandos se repetem.

Sugiro que depois de gravar a macro, método que tudo indica foi o utilizado para gerar este código, procure (através de estudo das funções VBA Script) como otimizar a saída apresentada,  fazendo laços e referências relativas. O código fica mais limpo e mais fácil de entender. Certamente exige um pouco de tempo de estudo para isso, mas valerá a pena.

Depois destes passos citados, certamente terá subsídios de corrigir as referências absolutas que apresentou e outros possíveis erros que apareçam.

Vale lembrar que sem o acesso aos dados (mesmo que com dados hipotéticos), alguém (voluntário) que for reproduzir o código acima para ajudar, pode ficar um pouco perdido.  Forneça um arquivo exemplo, preferencialmente ainda sem o código, ou seja, somente com os dados, para uma possível verificação.

Esta resposta foi útil?

0 comentários

0 respostas adicionais

Classificar por: Mais útil
Mais útil Mais Novo Mais Antigo