Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
COPIAR PARA A PROXI...
 
Notifications
Clear all

COPIAR PARA A PROXIMA LINHA

 
2024 - VBA & Macros
Post Recente por rattobr 10 anos atrás
4 Posts
3 Usuários
0 Reactions
1,192 Visualizações
RSS
 rattobr
(@rattobr)
Posts: 0
New Member
Topic starter
 

Primeiramente bom dia a todos, estou tendo dificuldade no ato de criar a macro, ele copiar de uma formulário em colunas, colar em outra pasta de trabalho, em linhas, e sem formatação, o ato de copiar eu ja consegui, o que eu não consigo é fazem com que ele copie para linha de baixo, ou a proxima vazia, segue abaixo ação do botão.

Sub Botão52_Clique()

    Dim LR
    
        LR = Sheets("DataBase").Range("A10000").End(xlDown)
        LR = Sheets("DataBase").Range("A1:A1000").Select
        Sheets("DataBase").Selection.End(xlUp).Select
        LR = LR + 1
        
        
    If LR <> "" Then
    
      Sheets("Formulario").Range("COD_TOURO").Copy Sheets("DataBase").Range("A" & LR)
      Sheets("Formulario").Range("NOME_TOURO").Copy Sheets("DataBase").Range("B" & LR)
      Sheets("Formulario").Range("DT_NASC").Copy Sheets("DataBase").Range("C" & LR)
      Sheets("Formulario").Range("NASCIO").Copy Sheets("DataBase").Range("D" & LR)
      Sheets("Formulario").Range("APT").Copy Sheets("DataBase").Range("E" & LR)
      Sheets("Formulario").Range("ORIG").Copy Sheets("DataBase").Range("F" & LR)
      Sheets("Formulario").Range("RAÇA").Copy Sheets("DataBase").Range("G" & LR)
      Sheets("Formulario").Range("SIGLA_FORM").Copy Sheets("DataBase").Range("H" & LR)
      Sheets("Formulario").Range("PARENT").Copy Sheets("DataBase").Range("I" & LR)
      Sheets("Formulario").Range("NOME_PARENT").Copy Sheets("DataBase").Range("J" & LR)
      Sheets("Formulario").Range("DT_FILM").Copy Sheets("DataBase").Range("K" & LR)
      Sheets("Formulario").Range("DT_PUB").Copy Sheets("DataBase").Range("L" & LR)
      Sheets("Formulario").Range("DT_T_TOURO").Copy Sheets("DataBase").Range("M" & LR)
      Sheets("Formulario").Range("OBS").Copy Sheets("DataBase").Range("N" & LR)
    
    End If
    
    LR = LR + 1

  
End Sub

Desde já agradeço a explicação e ajuda de vocês.

 
Postado : 28/11/2014 6:10 am
 Trindade
(@trindade)
Posts: 0
New Member
 

Bom dia, rattobr.

Não cheguei a testar, mas tente assim:

Sub Botão52_Clique()

Dim Linha As Integer

    Linha = Sheets("DataBase").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
        
		If LR <> "" Then
		
		  Sheets("Formulario").Range("COD_TOURO").Copy Sheets("DataBase").Range("A" & Linha)
		  Sheets("Formulario").Range("NOME_TOURO").Copy Sheets("DataBase").Range("B" & Linha)
		  Sheets("Formulario").Range("DT_NASC").Copy Sheets("DataBase").Range("C" & Linha)
		  Sheets("Formulario").Range("NASCIO").Copy Sheets("DataBase").Range("D" & Linha)
		  Sheets("Formulario").Range("APT").Copy Sheets("DataBase").Range("E" & Linha)
		  Sheets("Formulario").Range("ORIG").Copy Sheets("DataBase").Range("F" & Linha)
		  Sheets("Formulario").Range("RAÇA").Copy Sheets("DataBase").Range("G" & Linha)
		  Sheets("Formulario").Range("SIGLA_FORM").Copy Sheets("DataBase").Range("H" & Linha)
		  Sheets("Formulario").Range("PARENT").Copy Sheets("DataBase").Range("I" & Linha)
		  Sheets("Formulario").Range("NOME_PARENT").Copy Sheets("DataBase").Range("J" & Linha)
		  Sheets("Formulario").Range("DT_FILM").Copy Sheets("DataBase").Range("K" & Linha)
		  Sheets("Formulario").Range("DT_PUB").Copy Sheets("DataBase").Range("L" & Linha)
		  Sheets("Formulario").Range("DT_T_TOURO").Copy Sheets("DataBase").Range("M" & Linha)
		  Sheets("Formulario").Range("OBS").Copy Sheets("DataBase").Range("N" & Linha)
		
		End If
  
End Sub
 
Postado : 28/11/2014 8:48 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Um raciocínio séria..
Copiar até a ultima linha da guia origem e colar na ultima linha da guia destino!

Sub Copiar()

    Dim lr As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Set ws1 = Sheets("Plan1")
    Set ws2 = Sheets("Plan2")

    lr = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    ws1.Range("A1:H" & lr).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        
End Sub

http://www.globaliconnect.com/excel/ind ... Itemid=475
http://www.rondebruin.nl/win/s3/win001.htm

Att

 
Postado : 28/11/2014 8:59 am
 rattobr
(@rattobr)
Posts: 0
New Member
Topic starter
 

Muito obrigado meu amigos! bom resto de sexta, e um ótimo final de semana! :D

 
Postado : 28/11/2014 9:34 am
Forum Jump:
  Tópico Anterior
Próximo Tópico