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,501 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