none
Copiar e Colar RRS feed

  • Pergunta

  • Boa noite!!

    Tenho um arquivo que eu gostaria de fazer da seguinte forma:

    Copiar da planliha "Separação" tudo da coluna "A" ,"B", "C","D","E","G","M" e jogar apartir da 3 linha na planilha "Relatorios".

     

    Segue o arquivo para melhor exemplificar..

    http://www.4shared.com/file/kQRPJSCa/Ale.html

    Obrigado!!!!!!!!!


    zinho
    sábado, 30 de abril de 2011 19:35

Respostas

  • Certifique-se de que os cabeçalhos teham exatamente a mesma descrição:

    Const lDadosSeparação As Long = 2
    Const lDadosRelatórios As Long = 4
    
    Sub Copiar()
      Dim wsSeparação As Worksheet, wsRelatórios As Worksheet
      Dim r As Long, c As Long
      Dim lCabeçalhoSeparação As Long
      Dim lCabeçalhosRelatórios As Long
      Dim rng As Range
      
      Application.ScreenUpdating = False
      
      lCabeçalhoSeparação = lDadosSeparação - 1
      lCabeçalhoRelatórios = lDadosRelatórios - 1
      
      With ThisWorkbook
        Set wsSeparação = .Sheets("Separação")
        Set wsRelatórios = .Sheets("Relatorios ")
      End With
      
      With wsRelatórios
        .Rows(lDadosRelatórios).Resize(.UsedRange.Rows.Count).ClearContents
      End With
      
      For c = 1 To ÚltimaColuna(wsSeparação, lCabeçalhoSeparação)
        Set rng = wsRelatórios.Rows(lCabeçalhoRelatórios).Find(wsSeparação.Cells(lCabeçalhoSeparação, c), , , xlWhole)
        If Not rng Is Nothing Then
          With wsSeparação
            .Range(.Cells(lDadosSeparação, c), .Cells(ÚltimaLinha(wsSeparação, c), c)).Copy
          End With
          wsRelatórios.Cells(lDadosRelatórios, rng.Column).PasteSpecial xlPasteValues
        Else
          Debug.Print "Cabeçalho não encontrado: " & wsSeparação.Cells(lCabeçalhoSeparação, c)
        End If
      Next c
      
      With wsRelatórios
        .Range(.Cells(lDadosRelatórios, "F"), .Cells(ÚltimaLinha(wsRelatórios, "A"), "F")).Formula = "=VLOOKUP(RC[-5],Fração!R2C1:R3591C14,4,0)"
      End With
      
      Application.ScreenUpdating = True
    
    End Sub
    
    Function ÚltimaLinha(ws As Worksheet, c) As Long
      With ws.Columns(c)
        ÚltimaLinha = .Find(What:="*", After:=.Cells(1), SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
      End With
    End Function
     
    Function ÚltimaColuna(ws As Worksheet, r As Long) As Long
      With ws.Rows(r)
        ÚltimaColuna = .Find(What:="*", After:=.Cells(1), SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
      End With
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta zinhovba segunda-feira, 6 de junho de 2011 23:29
    segunda-feira, 6 de junho de 2011 10:15
    Moderador

Todas as Respostas

  • Zinho, tente o seguinte

     

    www.officevb.com/.../inserindo-dados-de-uma-planilha-em.html

     

    Teste ai e qqer coisa fale.

     

    Att


    Bruno Silva Leite
    officevb.com
    terça-feira, 3 de maio de 2011 00:36
  •  

    Eu estava sem NET, e demorei responder...tentei seu link mas, quando acesso diz que pagina não existe!


    zinho
    sábado, 28 de maio de 2011 18:49
  • Zinha, não consigo baixar o seu arquivo. Disponibilize novamente.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    sábado, 28 de maio de 2011 23:10
    Moderador
  • Boa noite!!!

     

    OK..perdoe-me..segue

     

    http://www.4shared.com/file/dwXpublm/Ale.html

     

    Att..


    zinho
    domingo, 29 de maio de 2011 22:05
  • A Planilha Separação não possui registros e a Relatório não existe. Poderia explicar melhor?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    segunda-feira, 30 de maio de 2011 03:39
    Moderador
  • Boa noite!!

    Por favor me perdoe..considere o novo link:http://www.4shared.com/file/uaEh_c4M/Nova_planilha_de_Relatorios.html

    Então, quando eu executo a guia "Macro", ela joga as informações para a Guia "Separação", depois disso...segue o que quero.

     

    Gostaria de poder jogar após a 3 linha como mostra a guia Relatórios e que os dados fossem puxados de acordo com as guias mencionadas na planilha "Relatório"

      Material          / Descrição        /T.Dep Endereço   /   ABC/            /   Fração            /  M.Venda       /   S.Total

    Guia Separação/Guia Separação /Guia Separação/   Guia Separação/   Guia Fração    /Guia Separação /Guia Separação  

     

    Obs: Como a maior parte do processo será pela Guia Separação, quando chegar na parte da Guia Fração deve haver um procv puxando a coluna onde fica o Material .

     

     

    Att..


    zinho
    segunda-feira, 30 de maio de 2011 22:33
  • Deixa eu ver se entendi direito: todos os dados da Planilha separação serão copiados (sem filtro algum) para a Planilha Relatórios, que deverá conter uma coluna que fará um PROCV buscando dados da Planilha Fração?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    terça-feira, 31 de maio de 2011 09:28
    Moderador
  • Está plena mente correto!!!...é isso mesmo ...mas, por curiosidade, também é possível mandar informações de uma planilha (Guia), para a outra se baseando no cabeçalho da planilha destino?
    zinho
    quinta-feira, 2 de junho de 2011 21:48
  • Sim. Uma alternativa sem macro seria o uso da ferramenta Consolidar Dados. Busque mais sobre o assunto.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    sábado, 4 de junho de 2011 11:19
    Moderador
  •  OBrigado mais não vai servir exatamente para o que eu quero, se vc poder me ajudar...

    ..Como vc mesmo havia falado.

    todos os dados da Planilha separação serão copiados (sem filtro algum) para a Planilha Relatórios, que deverá conter uma coluna que fará um PROCV buscando dados da Planilha Fração


    zinho
    segunda-feira, 6 de junho de 2011 01:42
  • Certifique-se de que os cabeçalhos teham exatamente a mesma descrição:

    Const lDadosSeparação As Long = 2
    Const lDadosRelatórios As Long = 4
    
    Sub Copiar()
      Dim wsSeparação As Worksheet, wsRelatórios As Worksheet
      Dim r As Long, c As Long
      Dim lCabeçalhoSeparação As Long
      Dim lCabeçalhosRelatórios As Long
      Dim rng As Range
      
      Application.ScreenUpdating = False
      
      lCabeçalhoSeparação = lDadosSeparação - 1
      lCabeçalhoRelatórios = lDadosRelatórios - 1
      
      With ThisWorkbook
        Set wsSeparação = .Sheets("Separação")
        Set wsRelatórios = .Sheets("Relatorios ")
      End With
      
      With wsRelatórios
        .Rows(lDadosRelatórios).Resize(.UsedRange.Rows.Count).ClearContents
      End With
      
      For c = 1 To ÚltimaColuna(wsSeparação, lCabeçalhoSeparação)
        Set rng = wsRelatórios.Rows(lCabeçalhoRelatórios).Find(wsSeparação.Cells(lCabeçalhoSeparação, c), , , xlWhole)
        If Not rng Is Nothing Then
          With wsSeparação
            .Range(.Cells(lDadosSeparação, c), .Cells(ÚltimaLinha(wsSeparação, c), c)).Copy
          End With
          wsRelatórios.Cells(lDadosRelatórios, rng.Column).PasteSpecial xlPasteValues
        Else
          Debug.Print "Cabeçalho não encontrado: " & wsSeparação.Cells(lCabeçalhoSeparação, c)
        End If
      Next c
      
      With wsRelatórios
        .Range(.Cells(lDadosRelatórios, "F"), .Cells(ÚltimaLinha(wsRelatórios, "A"), "F")).Formula = "=VLOOKUP(RC[-5],Fração!R2C1:R3591C14,4,0)"
      End With
      
      Application.ScreenUpdating = True
    
    End Sub
    
    Function ÚltimaLinha(ws As Worksheet, c) As Long
      With ws.Columns(c)
        ÚltimaLinha = .Find(What:="*", After:=.Cells(1), SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
      End With
    End Function
     
    Function ÚltimaColuna(ws As Worksheet, r As Long) As Long
      With ws.Rows(r)
        ÚltimaColuna = .Find(What:="*", After:=.Cells(1), SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column
      End With
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta zinhovba segunda-feira, 6 de junho de 2011 23:29
    segunda-feira, 6 de junho de 2011 10:15
    Moderador
  • Boa noite!!

     

    Cara com sertesa vc não é desse planeta....kkkkkkkkkkkkkkkk..que manero!!!!!

     

    Fiz um pequeno teste, espero não ter que te incomodar mais com esse mesmo assunto.rsrrs...deve ter dado trabalho.

     

    Obrigado!!!!!!...Obrigado!!!!!!!!!!!!!!!!!!!!!!

    ..Muito Obrigado Mesmo!!!!!!!!!!!..valeu

    Att..


    zinho
    segunda-feira, 6 de junho de 2011 23:28