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

COPIAR E COLAR UMA LINHA ABAIXO

 
2024 - VBA & Macros
Post Recente por FragosoJP 8 anos atrás
3 Posts
2 Usuários
0 Reactions
1,171 Visualizações
RSS
 FragosoJP
(@fragosojp)
Posts: 101
Estimable Member
Topic starter
 

boa tarde pessoas

mais uma vez preciso de ajuda de vocês

tenho um relatório diário, dele eu extraio todas as informações e crio um banco de dados

eu tenho esse código VBA que auxilia na hora de transpor os dados, porem eu precisava que toda vez que executa se a macro ele fosse inserindo os valores copiados da plan1 e inseri se uma linha abaixo da ultima célula preenchida da plan2

Sub extrair()
Dim i As Integer, j As Byte
j = 2

With Plan1

  For i = 3 To .Range("B" & Rows.Count).End(xlUp).Row
    If Sheets("Plan1").Range("D" & i).Value > 0 Then
       Plan2.Range("A" & j) = .Range("A" & i)
       Plan2.Range("B" & j) = .Range("B" & i)
       Plan2.Range("C" & j) = .Range("C" & i)
       Plan2.Range("D" & j) = .Range("D" & i)
       Plan2.Range("E" & j) = .Range("E" & i)
       Plan2.Range("F" & j) = .Range("F" & i)
       Plan2.Range("G" & j) = .Range("G" & i)
       Plan2.Range("I" & j) = .Range("I" & i)
       Plan2.Range("J" & j) = .Range("J" & i)
       Plan2.Range("K" & j) = .Range("K" & i)
       Plan2.Range("L" & j) = .Range("L" & i)
       Plan2.Range("M" & j) = .Range("M" & i)
       Plan2.Range("N" & j) = .Range("N" & i)
       
       
       j = j + 1
    End If
  Next i
End With
End Sub
 
Postado : 16/05/2017 12:00 pm
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Boa tarde!

Altere seu código para este:

Sub extrair()
    Dim i As Integer, j As Byte
    Dim UltimaLinha As Long
    
    'Se sua coluna A da Plan2 contiver dados da linha 1 até o final onde vão seis dados _
    você pode utilizar esse comando como está. Caso, contyrário, troque o número 1 peli _
    número de outra coluna que tenha dados do começo ao fim (sem células vazias pelo meio).
    UltimaLinha = Sheets("Plan2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    
    'Supondo que os dados começam logo abaixo do cabeçalho
    If UltimaLinha < 2 Then
        UltimaLinha = 2
    Else
        UltimaLinha = UltimaLinha + 1
    End If
    
    'j = 2
    
    With Plan1
    
      For i = 3 To .Range("B" & Rows.Count).End(xlUp).Row
        If Sheets("Plan1").Range("D" & i).Value > 0 Then
           Plan2.Range("A" & UltimaLinha) = .Range("A" & i)
           Plan2.Range("B" & UltimaLinha) = .Range("B" & i)
           Plan2.Range("C" & UltimaLinha) = .Range("C" & i)
           Plan2.Range("D" & UltimaLinha) = .Range("D" & i)
           Plan2.Range("E" & UltimaLinha) = .Range("E" & i)
           Plan2.Range("F" & UltimaLinha) = .Range("F" & i)
           Plan2.Range("G" & UltimaLinha) = .Range("G" & i)
           Plan2.Range("I" & UltimaLinha) = .Range("I" & i)
           Plan2.Range("J" & UltimaLinha) = .Range("J" & i)
           Plan2.Range("K" & UltimaLinha) = .Range("K" & i)
           Plan2.Range("L" & UltimaLinha) = .Range("L" & i)
           Plan2.Range("M" & j) = .Range("M" & i)
           Plan2.Range("N" & j) = .Range("N" & i)
           
           
           'j = j + 1
        End If
      Next i
    End With
End Sub

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 16/05/2017 12:15 pm
 FragosoJP
(@fragosojp)
Posts: 101
Estimable Member
Topic starter
 

wagner, muito oibrgado

consegue agora adaptei o código e ficou ótimo,

Sub extrair()
    Dim i As Integer, j As Byte
    Dim UltimaLinha As Long
    
    'Se sua coluna A da Plan2 contiver dados da linha 1 até o final onde vão seis dados _
    você pode utilizar esse comando como está. Caso, contyrário, troque o número 1 peli _
    número de outra coluna que tenha dados do começo ao fim (sem células vazias pelo meio).
    UltimaLinha = Sheets("Plan2").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    
    'Supondo que os dados começam logo abaixo do cabeçalho
    If UltimaLinha < 2 Then
        UltimaLinha = 2
    Else
        UltimaLinha = UltimaLinha + 1
    End If
    
    'j = 2
    
    With Plan1
    
      For i = 3 To .Range("B" & Rows.Count).End(xlUp).Row
        If Sheets("Plan1").Range("D" & i).Value > 0 Then
           Plan2.Range("A" & UltimaLinha) = .Range("A" & i)
           Plan2.Range("B" & UltimaLinha) = .Range("B" & i)
           Plan2.Range("C" & UltimaLinha) = .Range("C" & i)
           Plan2.Range("D" & UltimaLinha) = .Range("D" & i)
           Plan2.Range("E" & UltimaLinha) = .Range("E" & i)
           Plan2.Range("F" & UltimaLinha) = .Range("F" & i)
           Plan2.Range("G" & UltimaLinha) = .Range("G" & i)
           Plan2.Range("I" & UltimaLinha) = .Range("I" & i)
           Plan2.Range("J" & UltimaLinha) = .Range("J" & i)
           Plan2.Range("K" & UltimaLinha) = .Range("K" & i)
           Plan2.Range("L" & UltimaLinha) = .Range("L" & i)
           Plan2.Range("M" & UltimaLinha) = .Range("M" & i)
           Plan2.Range("N" & UltimaLinha) = .Range("N" & i)
           
           UltimaLinha = UltimaLinha + 1
        End If
      Next i
    End With
End Sub
 
Postado : 16/05/2017 12:26 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico