COPIAR PARA A PROXIMA LINHA

2024 - VBA & Macros

Post Recente por rattobr 10 anos atrás

4 Posts

3 Usuários

0 Reactions

1,203 Visualizações

RSS

rattobr

(@rattobr)

Posts: 8

Active 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: 278

Reputable 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

Se a resposta foi útil! Clique na mãozinha ao lado do botão Citar.
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde.

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

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 28/11/2014 8:59 am