Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
COPIAR E COLAR PULA...
 
Notifications
Clear all

COPIAR E COLAR PULANDO LINHA PREENCHIDA

 
2024 - VBA & Macros
Post Recente por barison28 6 anos atrás
5 Posts
2 Usuários
0 Reactions
1,499 Visualizações
RSS
 barison28
(@barison28)
Posts: 56
Trusted Member
Topic starter
 

Boa noite,

alguém pode me ajudar, pois eu não consegui.

tenho essa planilha e eu gostaria de uma macro que copia os dados de algumas linhas e grava na aba "quadro evolutivo" pulando a ultima linha preenchida e dentro do horário, tipo se for entre 07:00 a 07:59 ou 08:00 a 08:08:59 e assim vai.

copiar o conteudo das celulas da aba tch hora para quadro evolutivo.

 
Postado : 11/06/2018 8:56 pm
 barison28
(@barison28)
Posts: 56
Trusted Member
Topic starter
 
Sub CopiaColaValores()
  
    Dim UltimaLinha As Long
    Dim RngACopiar As Range
    
    'Define o Range a ser Copiado
    Set RngACopiar = Worksheets("TCH").Range("E9")
    Set RngACopiar = Worksheets("TCH").Range("H3")
    Set RngACopiar = Worksheets("TCH").Range("L6")
    Set RngACopiar = Worksheets("TCH").Range("L4")
    
    
    'Copia
    RngACopiar.Copy
    
    'Verifica a ultima linha preenchida na Coluna 3(C) da Plan2(Destino)
    UltimaLinha = Worksheets("QUADRO").Cells(Rows.Count, 3).End(xlUp).Row
    
    'Se for menor que 11 - ou seja se C11 estiver Vazia
    If UltimaLinha < 4 Then
        UltimaLinha = 4
        Worksheets("QUADRO").Range("C" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
         Worksheets("QUADRO").Range("D" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
          Worksheets("QUADRO").Range("E" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
           Worksheets("QUADRO").Range("F" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
        
    Else
    
        UltimaLinha = UltimaLinha + 1
        Worksheets("QUADRO").Range("C" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
        
    End If
    
    Application.CutCopyMode = False
    
    End Sub

EU COLOQUEI ESSE CODIGO MAS NÃO DA CERTO NÃO CNOSIGO COPIAR TODAS AS LINHAS.

 
Postado : 12/06/2018 2:52 pm
 barison28
(@barison28)
Posts: 56
Trusted Member
Topic starter
 

alguém pode me ajudar?

 
Postado : 16/06/2018 12:06 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
Option Explicit

Sub CopiaColaValores()
  
    Dim UltimaLinha As Long
    Dim RngACopiar As Range
    
    'Define o Range a ser Copiado
    Set RngACopiar = Worksheets("TCH").Range("E9")
    
    
    
    'Copia
    RngACopiar.Copy
    
    'Verifica a ultima linha preenchida na Coluna 3(C) da Plan2(Destino)
    UltimaLinha = Worksheets("QUADRO").Cells(Rows.Count, 3).End(xlUp).Row
    
    'Se for menor que 11 - ou seja se C11 estiver Vazia
    If UltimaLinha < 4 Then
        UltimaLinha = 4
        
        
'    Else
'
'        UltimaLinha = UltimaLinha + 1
'        Worksheets("QUADRO").Range("C" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
        
    End If
    
    Worksheets("QUADRO").Range("C" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
    
    
    Set RngACopiar = Worksheets("TCH").Range("H3")

        'Copia
    RngACopiar.Copy
    
         Worksheets("QUADRO").Range("D" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
         
             Set RngACopiar = Worksheets("TCH").Range("L6")
     'Copia
    RngACopiar.Copy
    
          Worksheets("QUADRO").Range("E" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
          
             Set RngACopiar = Worksheets("TCH").Range("L4")
             
                 'Copia
    RngACopiar.Copy
           Worksheets("QUADRO").Range("F" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
    
    Application.CutCopyMode = False
    
    End Sub
 
Postado : 17/06/2018 7:12 am
 barison28
(@barison28)
Posts: 56
Trusted Member
Topic starter
 

Cara é isso mesmo, muito obrigado!!

 
Postado : 18/06/2018 2:41 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico