Excel Transferir dados de uma planilha para outra usando VBA

Guilherme Stoduto · 26 de outubro de 2023

Bom dia Pessoal!

Necessito da ajuda de vocês, estou quebrando a cabeça a alguns dias com esse problema. Preciso mandar dados de uma planilha para outra, a segunda planilha eu estaria montando um relatório de todos os dados da primeira.

Segue exemplo:

Primeira tabela de registro

Segunda tabela onde quero mandar as informações para gerar um relatório.RELATÓRIO.xlsx

Já estou a dias quebrando a cabeça e procurando formas de desenvolver esse problema, só consegui preencher a primeira linha usando VBA e nada mais.

Se puderem me ajudar, agradeço imensamente!

Estou anexando os dois arquivos para ajudar.

REQUISIÇÃO.xlsx RELATÓRIO.xlsx

Midori · 26 de outubro de 2023

@Guilherme Stoduto Como os campos não estão organizados em sequencia e são vários, para facilitar pode ser aplicada a função de busca pelo nome dos camspos. Assim não terá que tratar cada um e atribuir manualmente, p.ex,

Const CODIGO_MATERIAL       As String = "CÓDIGO MATERIAL"
Const DESCRICAO_MATERIAL    As String = "DESCRIÇÃO MATERIAL"
Const QUANTIDADE_SOLICITADA As String = "QUANTIDADE SOLICITADA"
Const CHAPA                 As String = "CHAPA"
Const SUPERVISOR            As String = "SUPERVISOR"
Const COD_PESSOA            As String = "COD PESSOA"
Const SEGMENTO              As String = "SEGMENTO"
Const LOCALIDADE_DESTINO    As String = "LOCALIDADE DESTINO"
Const RETIRADA              As String = "RETIRADA"
Const DATARG                As String = "DATA"
Const LINHA_CAMPO_REQ       As Integer = 5

Sub SalvaRequisicoes()
    Dim Area        As Range
    Dim Campo       As Range
    Dim Requisicao  As Object
    Dim Linha       As Long
    
    Set Area = ThisWorkbook.Sheets("REQUISIÇÃO").[A1:E5]

    For Linha = 1 To 3
        Set Requisicao = BuscaRequisicao(Area, Linha)
        
        If Requisicao Is Nothing Then
            MsgBox "Erro, campo inválido", vbExclamation
            Exit For
        End If
    
        For Each Campo In Workbooks("RELATÓRIO.xlsx").Sheets("RELATÓRIO").[A2:K2]
            If Requisicao.Exists(Campo.Value) Then
                Campo(Linha + 1).Value = Requisicao.Item(Campo.Value)
            End If
        Next Campo
    Next Linha
    
    Set Requisicao = Nothing
End Sub

Function BuscaRequisicao(Area As Range, ByVal Linha As Double) As Object
    Dim Campo       As Variant
    Dim Valor       As Variant
    Dim Indice      As Integer
    Dim Requisicao  As Object
    Dim Busca       As Range
    
    Set Requisicao = CreateObject("Scripting.Dictionary")
        
    Campo = Array( _
        CODIGO_MATERIAL, _
        DESCRICAO_MATERIAL, _
        QUANTIDADE_SOLICITADA, _
        CHAPA, _
        SUPERVISOR, _
        COD_PESSOA, _
        SEGMENTO, _
        LOCALIDADE_DESTINO, _
        RETIRADA, _
        DATARG)

    For Each Valor In Campo
        Set Busca = Area.Find(What:=Valor, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Busca Is Nothing Then
            If Busca.Row = LINHA_CAMPO_REQ Then
                Call Requisicao.Add(Campo(Indice), Busca(Linha + 1).Value)
            Else
                Call Requisicao.Add(Campo(Indice), Busca(2).Value)
            End If
            Indice = Indice + 1
        Else
            Exit For
        End If
    Next Valor
    
    If UBound(Campo) + 1 <> Indice Then
        Set Requisicao = Nothing
    End If
    
    Set BuscaRequisicao = Requisicao
End Function

O código assume que são 10 campos e os nomes deles nas duas planilhas devem ser os mesmos. A macro deve ficar no módulo da planilha Requisição e nesse teste só pega 3 registros. Você pode editar o loop das linhas para pegar a quantidade automaticamente.

Para mandar um registro para o relatório é só passar o número da linha da tabela para o segundo argumento. O registro p.ex da linha 20 para a primeira linha da outra,

Set Requisicao = BuscaRequisicao(Area, 20)
        
For Each Campo In Workbooks("RELATÓRIO.xlsx").Sheets("RELATÓRIO").[A2:K2]
    If Requisicao.Exists(Campo.Value) Then
        Campo(2).Value = Requisicao.Item(Campo.Value)
    End If
Next Campo

Guilherme Stoduto · 27 de outubro de 2023

@Midori Estou usando o seguinte código:

Sub InserirDados()
    Application.ScreenUpdating = False
    
    Dim CodMaterial As String
    Dim Descricao As String
    Dim QuantidadeSolicitada As Long
    Dim SaldoEstoque As Long
    Dim Chapa As String
    Dim Supervisor As String
    Dim CodPessoa As Long
    Dim Segmento As String
    Dim LocalidadeDestino As String
    Dim CentroCusto As String
    Dim Retirada As String
    Dim Data As String
    Dim DC As String
    Dim UltimaLinha As Integer
    Dim I As Integer
    Dim Linha As Integer
    Dim Coluna As Integer
    
    Coluna = 1
    Linha = 6

        UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row
        
        For I = 6 To UltimaLinha
    
            Chapa = Sheets("REQUISIÇÃO").Range("A2")
            Supervisor = Sheets("REQUISIÇÃO").Range("B2")
            CodPessoa = Sheets("REQUISIÇÃO").Range("D2")
            Localidade = Sheets("REQUISIÇÃO").Range("A4")
            Segmento = Sheets("REQUISIÇÃO").Range("E2")
            CentroCusto = Sheets("REQUISIÇÃO").Range("B4")
            Retirada = Sheets("REQUISIÇÃO").Range("D4")
            Data = Sheets("REQUISIÇÃO").Range("E4")
                        
            CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I)
            Descricao = Sheets("REQUISIÇÃO").Range("C" & I)
            QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I)
            SaldoEstoque = Sheets("REQUISIÇÃO").Range("D" & I)
            DC = Sheets("REQUISIÇÃO").Range("A" & I)
    
            Sheets("RM").Activate
            Sheets("RM").Range("B2") = CodMaterial
            Sheets("RM").Range("C2") = Descricao
            Sheets("RM").Range("D2") = QuantidadeSolicitada
            Sheets("RM").Range("E2") = SaldoEstoque
            Sheets("RM").Range("F2") = Chapa
            Sheets("RM").Range("G2") = Supervisor
            Sheets("RM").Range("H2") = CodPessoa
            Sheets("RM").Range("I2") = Segmento
            Sheets("RM").Range("J2") = LocalidadeDestino
            Sheets("RM").Range("K2") = CentroCusto
            Sheets("RM").Range("L2") = Retirada
            Sheets("RM").Range("M2") = Data
            Sheets("RM").Range("N2") = DC
            
        Next I
End Sub

A minha duvida é como eu devo fazer o loop para ele preencher os dados de codmaterial, descrição, saldoestoque e quantidadesolicitada e preencher com a mesma informação das demais.

Nesse meu código ele só retorna a primeira linha, só o primeiro material, o restante ele não preenche.

Midori · 27 de outubro de 2023

@Guilherme Stoduto Acho mais simples fazer como comentei, veja que não atribuí um por um manualmente. No seu código para preencher as outras linhas é só colocar um contador, p.ex,

Dim LinhaRM As Long
...
Sheets("RM").Range("B2").Offset(LinhaRM).Value = CodMaterial
Sheets("RM").Range("C2").Offset(LinhaRM).Value = Descricao
...
LinhaRM = LinhaRM + 1

Guilherme Stoduto · 30 de outubro de 2023

@Midori copiei o código que você mencionou mas não funcionou, não deu erro porém mas preencheu nada.

Testei outro método, usando =célula para retornar o valor e depois usar o VBA para preencher o relatório.

código abaixo:

Sub InserirDados()
    Application.ScreenUpdating = False
   
    Dim CodMaterial As String
    Dim Descricao As String
    Dim QuantidadeSolicitada As String
    Dim Chapa As String
    Dim Supervisor As String
    Dim CodPessoa As String
    Dim Segmento As String
    Dim LocalidadeDestino As String
    Dim CentroCusto As String
    Dim Retirada As String
    Dim Data As String
    Dim DC As String
    Dim UltimaLinhaRE As Integer
    Dim UltimaLinhaRM As Integer
    Dim I As Integer
    Dim U As Integer
    
        UltimaLinhaRE = Sheets("REQUISIÇÃO").Range("G" & Rows.Count).End(xlUp).Row
        UltimaLinhaRM = Sheets("RM").Range("B" & Rows.Count).End(xlUp).Row
               
        For I = 2 To UltimaLinhaRE
    
            Chapa = Sheets("REQUISIÇÃO").Range("G" & I)
            Supervisor = Sheets("REQUISIÇÃO").Range("H" & I)
            CodPessoa = Sheets("REQUISIÇÃO").Range("I" & I)
            Segmento = Sheets("REQUISIÇÃO").Range("J" & I)
            LocalidadeDestino = Sheets("REQUISIÇÃO").Range("K" & I)
            CentroCusto = Sheets("REQUISIÇÃO").Range("L" & I)
            Retirada = Sheets("REQUISIÇÃO").Range("M" & I)
            Data = Sheets("REQUISIÇÃO").Range("N" & I)
            DC = Sheets("REQUISIÇÃO").Range("O" & I)
            CodMaterial = Sheets("REQUISIÇÃO").Range("P" & I)
            Descricao = Sheets("REQUISIÇÃO").Range("Q" & I)
            QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("R" & I)
            
        Next I
        For U = 2 To UltimaLinhaRM
            
            Sheets("RM").Activate
            Sheets("RM").Range("B" & U) = CodMaterial
            Sheets("RM").Range("C" & U) = Descricao
            Sheets("RM").Range("D" & U) = QuantidadeSolicitada
            Sheets("RM").Range("E" & U) = Chapa
            Sheets("RM").Range("F" & U) = Supervisor
            Sheets("RM").Range("G" & U) = CodPessoa
            Sheets("RM").Range("H" & U) = Segmento
            Sheets("RM").Range("I" & U) = LocalidadeDestino
            Sheets("RM").Range("J" & U) = CentroCusto
            Sheets("RM").Range("K" & U) = Retirada
            Sheets("RM").Range("L" & U) = Data
            Sheets("RM").Range("M" & U) = DC

        Next U
        
        Application.ScreenUpdating = True
End Sub

Achei esse método mais "fácil", porém continua não dando erro e preenchendo nada, porém estou com o feeling que esta falando alguma linha nesse código para funcionar corretamente, só não consigo encontrar.

Midori · 30 de outubro de 2023

@Guilherme Stoduto No seu primeiro código só faltava o contador para as linhas do relatório.

Sub InserirDados()
    Dim CodMaterial             As String
    Dim Descricao               As String
    Dim QuantidadeSolicitada    As Long
    Dim SaldoEstoque            As Long
    Dim Chapa                   As String
    Dim Supervisor              As String
    Dim CodPessoa               As Long
    Dim Segmento                As String
    Dim LocalidadeDestino       As String
    Dim CentroCusto             As String
    Dim Retirada                As String
    Dim Data                    As String
    Dim DC                      As String
    Dim UltimaLinha             As Long
    Dim I                       As Long
    Dim Linha                   As Long
    Dim Coluna                  As Integer
    Dim LinhaRM                 As Long
    
    Coluna = 1
    Linha = 6
    LinhaRM = 2
    
    UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row
        
    For I = 6 To UltimaLinha
        Chapa = Sheets("REQUISIÇÃO").Range("A2")
        Supervisor = Sheets("REQUISIÇÃO").Range("B2")
        CodPessoa = Sheets("REQUISIÇÃO").Range("D2")
        Localidade = Sheets("REQUISIÇÃO").Range("A4")
        Segmento = Sheets("REQUISIÇÃO").Range("E2")
        CentroCusto = Sheets("REQUISIÇÃO").Range("B4")
        Retirada = Sheets("REQUISIÇÃO").Range("D4")
        Data = Sheets("REQUISIÇÃO").Range("E4")
                        
        CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I)
        Descricao = Sheets("REQUISIÇÃO").Range("C" & I)
        QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I)
        SaldoEstoque = Sheets("REQUISIÇÃO").Range("D" & I)
        DC = Sheets("REQUISIÇÃO").Range("A" & I)
    
        Sheets("RM").Activate
        Sheets("RM").Range("B" & LinhaRM) = CodMaterial
        Sheets("RM").Range("C" & LinhaRM) = Descricao
        Sheets("RM").Range("D" & LinhaRM) = QuantidadeSolicitada
        Sheets("RM").Range("E" & LinhaRM) = SaldoEstoque
        Sheets("RM").Range("F" & LinhaRM) = Chapa
        Sheets("RM").Range("G" & LinhaRM) = Supervisor
        Sheets("RM").Range("H" & LinhaRM) = CodPessoa
        Sheets("RM").Range("I" & LinhaRM) = Segmento
        Sheets("RM").Range("J" & LinhaRM) = LocalidadeDestino
        Sheets("RM").Range("K" & LinhaRM) = CentroCusto
        Sheets("RM").Range("L" & LinhaRM) = Retirada
        Sheets("RM").Range("M" & LinhaRM) = Data
        Sheets("RM").Range("N" & LinhaRM) = DC
        LinhaRM = LinhaRM + 1
    Next I
End Sub

Guilherme Stoduto · 30 de outubro de 2023

@Midori Perfeito! Funcionou.

porém só preenche as primeiras linhas, se for gerar novamente ele vai substituir os dados e não inserir novos dados a partir da ultima linha preenchida. Preciso que continue preenchendo o relatório.

OreiaG · 30 de outubro de 2023

Alternativa.

Sub ReplicaDados()
 Dim wsO As Worksheet, wsD As Worksheet, LR As Long, k As Long, c As Long, r As Range
  Set wsO = ThisWorkbook.Sheets("REQUISIÇÃO")
  Set wsD = Workbooks("RELATÓRIO.xlsx").Sheets("RELATÓRIO")
  If wsO.[A6] = "" Then MsgBox "NÃO HÁ DADOS": Exit Sub
  LR = wsD.Cells(Rows.Count, 1).End(xlUp).Row + 1
  k = wsO.[A5].End(xlDown).Row - 5
  With wsD
   .Cells(LR, 1).Resize(k, 2).Value = wsO.Cells(6, 2).Resize(k, 2).Value
   .Cells(LR, 3).Resize(k).Value = wsO.Cells(6, 5).Resize(k).Value
   .Cells(LR, 11).Resize(k).Value = wsO.Cells(6, 1).Resize(k).Value
   For Each r In wsO.Range("A2,B2,D2,E2,A4,D4,E4")
    .Cells(LR, c + 4).Resize(k).Value = r.Value: c = c + 1
   Next r
   .Columns("A:K").AutoFit
  End With
End Sub

Midori · 30 de outubro de 2023

21 minutos atrás, Guilherme Stoduto disse:

se for gerar novamente ele vai substituir os dados e não inserir novos dados a partir da ultima linha preenchida

Da mesma forma que atribuiu a última linha para a variável UltimaLinha, você pode fazer o mesmo para LinhaRM. Em vez do valor 2 faça a atribuição ...End(xlUp).Row + 1.

Guilherme Stoduto · 31 de outubro de 2023

@Midori Código resolvido, tive que mudar algumas linhas, mas no fim, funcionou o que estava querendo.

Agradeço imensamente o suporte!

Segue abaixo o código final:

Sub InserirDados()
    
    Application.ScreenUpdating = False
    
    Dim CodMaterial             As String
    Dim Descricao               As String
    Dim QuantidadeSolicitada    As Long
    Dim Chapa                   As String
    Dim Supervisor              As String
    Dim CodPessoa               As Long
    Dim Segmento                As String
    Dim LocalidadeDestino       As String
    Dim CentroCusto             As String
    Dim Retirada                As String
    Dim Data                    As String
    Dim DC                      As String
    Dim UltimaLinha             As Integer
    Dim I                       As Integer
    Dim Linha                   As Long
    Dim Coluna                  As Integer
    Dim LinhaRM                 As Long
    
    Coluna = 1
    Linha = 6
    
    LinhaRM = Sheets("RM").Range("B" & Rows.Count).End(xlUp).Row + 1
        
    UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row
            
    For I = 6 To UltimaLinha
        Chapa = Sheets("REQUISIÇÃO").Range("A2")
        Supervisor = Sheets("REQUISIÇÃO").Range("B2")
        CodPessoa = Sheets("REQUISIÇÃO").Range("D2")
        LocalidadeDestino = Sheets("REQUISIÇÃO").Range("A4")
        Segmento = Sheets("REQUISIÇÃO").Range("E2")
        CentroCusto = Sheets("REQUISIÇÃO").Range("B4")
        Retirada = Sheets("REQUISIÇÃO").Range("D4")
        Data = Sheets("REQUISIÇÃO").Range("E4")
                        
        CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I)
        Descricao = Sheets("REQUISIÇÃO").Range("C" & I)
        QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I)
        DC = Sheets("REQUISIÇÃO").Range("A" & I)
    
        Sheets("RM").Activate
        Cells(LinhaRM, 2) = CodMaterial
        Cells(LinhaRM, 3) = Descricao
        Cells(LinhaRM, 4) = QuantidadeSolicitada
        Cells(LinhaRM, 5) = Chapa
        Cells(LinhaRM, 6) = Supervisor
        Cells(LinhaRM, 7) = CodPessoa
        Cells(LinhaRM, 8) = Segmento
        Cells(LinhaRM, 9) = LocalidadeDestino
        Cells(LinhaRM, 10) = CentroCusto
        Cells(LinhaRM, 11) = Retirada
        Cells(LinhaRM, 12) = Data
        Cells(LinhaRM, 13) = DC
        LinhaRM = LinhaRM + 1
    Next I
    
    Application.ScreenUpdating = True
End Sub