Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar e Colar em L...
 
Notifications
Clear all

Copiar e Colar em Linhas Diferentes a Cada Clique do Botão

 
2024 - VBA & Macros
Post Recente por Renan 12 anos atrás
5 Posts
2 Usuários
0 Reactions
1,359 Visualizações
RSS
 Renan
(@renan)
Posts: 8
Active Member
Topic starter
 

Bom dia a todos.

Sou novo no fórum e também em códigos VBA.
Recorro a vossas experiências para ajudar-me, vou tentar explicar da forma mais detalhada minha necessidade.

Em minha pasta de trabalho possuo duas planilhas, "Cálculo" e "Proposta". Na planilha "Cálculo" existem dois valores (um em "H21" e outro "J21") além de um botão "Gravar".

Basicamente o que preciso é que quando o usuário clicar no botão "Gravar", o mesmo cole tais valores (Cálculo! H21 e J21) nas células "C3" e "E3" respectivamente na planilha "Proposta", e em seguida apague os valores das células "C5", "F5", "H5", "J5", "F12" e "H12" da planilha "Cálculo". Até este ponto pra mim é tranquilo fazer, mas agora é que o "bicho pega".

Cada vez que o usuário clicar no botão "Gravar" eu quero que os valores de "H21" e "J21" sejam colados em linhas diferentes ao do clique anterior, mantendo os anteriores em suas respectivas células. Por exemplo:

Primeiro Clique:
Copy From "Cálculo" "H21","J21" Paste To "Proposta" "C3", "E3";

Segundo Clique:
Copy From "Cálculo" "H21","J21" Paste To "Proposta" "C4", "E4";

Terceiro Clique:
Copy From "Cálculo" "H21","J21" Paste To "Proposta" "C5", "E5";
.
.
Décimo Clique:
Copy From "Cálculo" "H21","J21" Paste To "Proposta" "CX", "EX";

Esta é a primeira parte da necessidade, a segunda é:

Na planilha "Proposta" haverá um botão para apagar os valores de "C3", "E3" até "C15", "E15" por exemplo. Que nada mais é que os valores copiados da planilha "Cálculo" a cada clique que o usuário fez.

Contudo, além do botão ter a função de apagar, preciso que ele "resete" o botão "Gravar" para que o mesmo volte a colar nas células iniciais ("C3", "E3") e não continuar da onde ele parou.

Gostaria de resaltar, que as células aqui informadas, são para efeitos de exemplo, se puderem por gentileza deixar de uma forma fácil a alteração do codigo para que eu ajuste conforme a necessidade, agradeço-lhes.

Muito obrigado pela ajuda e atenção.

Att,

Renan Rodrigues.

 
Postado : 21/01/2013 6:07 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez assim:

Sub Transfer()
Dim r As Integer
'Copia as celulas H21 e J21 da planilha Calculo
Sheets("Cálculo").Range("H21,J21").Copy
'Posiciona na planilha Proposta
    With Worksheets("Proposta")
        'Determina qual a ultima linha com valor na coluna C e adiciona 1
             r = .Cells(Cells.Rows.Count, "C").End(xlUp).Row + 1
        'Seleciona a celula C mais ultima linha
        .Cells(r, 3).Select
        'Cola os dados sem formulas (se houver)
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End With
End Sub
 
Postado : 21/01/2013 6:30 am
 Renan
(@renan)
Posts: 8
Active Member
Topic starter
 

Reinaldo, bom dia!

Obrigado pela atenção e ajuda.

Fiz um teste, e quando executado a partir do botão "Gravar" mostra o seguinte erro:

"Erro em tempo de execução 1004:
O método Select da classe Range falhou".

Depurando o erro, ele mostra pra mim a linda do código:
".Cells(r, 3).Select"

Mais um detalhe, preciso que o código copie os valores de "H21" e "J21", como já está, mas que cole em "Proposta" "D4, F4", respectivamente.

Obrigado mais uma vez.

Att, Renan.

 
Postado : 21/01/2013 6:58 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez assim então:

Sub Transfer2()
Dim r As Integer
Sheets("Proposta").Activate
'Determina qual a ultima linha com valor na coluna C e adiciona 1
    r = Sheets("Proposta").Cells(Cells.Rows.Count, "C").End(xlUp).Row + 1
'Copia as celulas H21 da planilha Calculo
    Sheets("Cálculo").Range("H21").Copy
'Cola os dados sem formulas (se houver)
    Sheets("Proposta").Range("C" & r).Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Copia as celulas H21 e J21 da planilha Calculo
    Sheets("Cálculo").Range("J21").Copy
'Cola os dados sem formulas (se houver)
    Sheets("Proposta").Range("E" & r).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Cálculo").Activate
Application.CutCopyMode = False
End Sub
 
Postado : 21/01/2013 8:06 am
 Renan
(@renan)
Posts: 8
Active Member
Topic starter
 

Reinaldo,

Perfeito cara, funcionou 100%.

Muito obrigado mesmo!

Abraços.

Att, Renan.

 
Postado : 21/01/2013 8:40 am
Forum Jump:
  Tópico Anterior
Próximo Tópico