locked
Macro copiar volares em colunas procura por dia RRS feed

  • Pergunta

  • Bom dia pessoal!

     

    A situação é a seguinte;

     

    Tenho uma planinha que dia a dia na sheet1 ela me dá na coluna "B" uma quantidade de valores diferentes (B4:B20), estes valores são puxados através de formula, ou seja, eu vejo os valores, porém na coluna/linha tem uma formula. Este valores/formulas eu copio e colo como valores na sheet2 na coluna referente ao dia.

     

    Sheet1 – Data (=today) e Dia (=day(today())

    O valor é obtido com formula

    25/1/2011

     

    Dia

    25

    Valor

    2

    Valor

    3

     

     

    Sheet2 – Dias fixos na planilha -

     

    Dia

    1

    2

    3

    4

    25

    Valor

     

     

     

     

    2

     Valor

     

     

     

     

    3

     

     

     

     

     

     

     

     

    Quero criar uma macro que verifique o dia da sheet1 com a posição do dia da sheet2 e quando encontrada esta posição, o valor da coluna B da sheet1 seja colado na sheet2

    terça-feira, 25 de janeiro de 2011 07:47

Respostas

  • Construa uma Pasta de Trabalho assim:

     

    Planilha Plan1:

    A1 = Dia

    A2 = Valor

    A3 = Valor

    A4 = Valor

    B1 = 12/01/2011

    B2 = 1

    B3 = 2

    B4 = 3

     

    Planilha Plan2:

    A1 = 01/01/2011

    B1 = 02/01/2011

    C1 = 03/01/2011

    ... até ...

    AE1 = 31/01/2011

     

    Utilize o código abaixo:

     

    Sub ColarValores()
      
      Dim wsO As Worksheet, wsD As Worksheet
      Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long
      Dim dDia As Date
      Dim rngBanco As Range, rng As Range
      
      Set wsO = Sheets("Plan1")
      Set wsD = Sheets("Plan2")
      
      With wsO
        rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row
        dDia = .Range("B1")
        Set rngBanco = wsD.Rows(1)
        Set rng = rngBanco.Find(dDia)
        lCol = rng.Column
        rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row
        .Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD)
      End With
      
    End Sub

     

    Se quiser um exemplo pronto, baixe aqui: http://www.megaupload.com/?d=RJAAGC4K


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:32
    terça-feira, 25 de janeiro de 2011 21:44
  • A macro do Benzadeus está correta. É necessário ajustar ao seu caso.

    Tente:

     

    Option Explicit

    Sub ColarValores()
       
        Dim wsO As Worksheet, wsD As Worksheet
        Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long
        Dim dDia As Integer
        Dim rngBanco As Range, rng As Range
       
        Set wsO = Sheets("Plan1")
        Set wsD = Sheets("Plan2")
       
        With wsO
            rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row
            dDia = .Range("B1")
            Set rngBanco = wsD.Rows(1 )
            Set rng = rngBanco.Find(dDia)
            lCol = rng.Column
            rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row
            .Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD)
        End With
       
    End Sub

    Os números de 1 a 31 em Plan2 devem estar na linha 1. Se não estiverem, troque o 1 do código (em negrito) pela linha em que estão.

     

    Abs,

     

     

     

    • Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:28
    quinta-feira, 27 de janeiro de 2011 01:22
  • Bom dia pessoal!

     

     

    Consegui fazer funcionar do jeito que eu queria. Criei uma estrutura em IF..ELSEIF..ENDIF e está funcionado blz.

    O código ficou grande, mas como está funcionando do jeito que eu queria, então tudo bem.

     

    Grato pela ajuda de todos.

    Fuuuiii.

    • Marcado como Resposta rsant terça-feira, 15 de março de 2011 07:53
    terça-feira, 1 de fevereiro de 2011 07:05

Todas as Respostas

  • Construa uma Pasta de Trabalho assim:

     

    Planilha Plan1:

    A1 = Dia

    A2 = Valor

    A3 = Valor

    A4 = Valor

    B1 = 12/01/2011

    B2 = 1

    B3 = 2

    B4 = 3

     

    Planilha Plan2:

    A1 = 01/01/2011

    B1 = 02/01/2011

    C1 = 03/01/2011

    ... até ...

    AE1 = 31/01/2011

     

    Utilize o código abaixo:

     

    Sub ColarValores()
      
      Dim wsO As Worksheet, wsD As Worksheet
      Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long
      Dim dDia As Date
      Dim rngBanco As Range, rng As Range
      
      Set wsO = Sheets("Plan1")
      Set wsD = Sheets("Plan2")
      
      With wsO
        rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row
        dDia = .Range("B1")
        Set rngBanco = wsD.Rows(1)
        Set rng = rngBanco.Find(dDia)
        lCol = rng.Column
        rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row
        .Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD)
      End With
      
    End Sub

     

    Se quiser um exemplo pronto, baixe aqui: http://www.megaupload.com/?d=RJAAGC4K


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:32
    terça-feira, 25 de janeiro de 2011 21:44
  • Fala velhinho, pelo que testei não funcionou.

     

    Segue ai uma idéia do que estou tentando fazer;

     

    Sub testemacro()

       

        Range("A2:A7").Select                                                                'Selecionas linhas da coluna

        Selection.Copy                                                                              'Copia as células selecionadas

        Sheets("Sheet2").Select                                                            'Muda para a sheet2

        Range("A2").Select                                                                     'Clica na selula A2

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False                                                    'Faz a copia especial

        Sheets("Sheet1").Select

        Application.CutCopyMode = False

    End Sub

     

    Mas, além disto, eu preciso de uma forma de primeiro testar a data da planilha1 com a planilha2, quando a data for encontrada realizar esta operação.

     

    A operação deverá ser acionada através de um botão na planilha1.

     

    Será que tem como ser feito isso?

     

    Grato,

     

    quarta-feira, 26 de janeiro de 2011 04:48
  • Você baixou o exemplo no link que eu postei? Está funcionando. Através do método Find o programa faz esse teste que você citou.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    quarta-feira, 26 de janeiro de 2011 08:32
  • A macro do Benzadeus está correta. É necessário ajustar ao seu caso.

    Tente:

     

    Option Explicit

    Sub ColarValores()
       
        Dim wsO As Worksheet, wsD As Worksheet
        Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long
        Dim dDia As Integer
        Dim rngBanco As Range, rng As Range
       
        Set wsO = Sheets("Plan1")
        Set wsD = Sheets("Plan2")
       
        With wsO
            rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row
            dDia = .Range("B1")
            Set rngBanco = wsD.Rows(1 )
            Set rng = rngBanco.Find(dDia)
            lCol = rng.Column
            rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row
            .Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD)
        End With
       
    End Sub

    Os números de 1 a 31 em Plan2 devem estar na linha 1. Se não estiverem, troque o 1 do código (em negrito) pela linha em que estão.

     

    Abs,

     

     

     

    • Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:28
    quinta-feira, 27 de janeiro de 2011 01:22
  • Valeu galera!

    O código de Benzadeus estava blz, eu é que não tinha conseguido fazer as mudanças necessárias. Acho que trabalhar a noite causa isso, rsrsrsr.

     

    grato,

     

    quinta-feira, 27 de janeiro de 2011 02:31
  • Bem pessoal, estive fazendo outros testes e minha necessidade mudou.

     

    Dentro do que eu pedi anteriormente, a rotina está funcionando muito bem, porém a minha necessidade é outra e como sou novo em VBA pessoa ajuda de vocês mais uma vez.

     

    Segue link com a planilha semelhante a que uso.

     

    http://www.megaupload.com/?d=SYQAS7U1

     

    O dia é obtido através de formula   ( =day(today()) formatada como número)

    Copio  D15:46  e colo especial na planilha ACUMULADOS referente a cada dia e o mesmo faço com a coluna E

    Na ACUMULADOS a formatação dos número é como geral

     

    Não estou conseguindo percorrer os dias.

     

    Tem como me ajudarem novamente?

    quinta-feira, 27 de janeiro de 2011 06:52
  • O que quer dizer que não está conseguindo percorrer os dias?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    quinta-feira, 27 de janeiro de 2011 20:56
  • Como a configuração de minha tabela é diferente da que foi proposta anteriormente, exemplo:

    A data principal da tabela BCO_DADOS em minha planilha é uma formula ( =day(today()) ) e está em uma coluna/linha diferente da tabela proposta anteriormente por vc.

    A data na planilha ACUMULADOS é apenas uma numeração de 01 a 31 e não necessariamente uma "data" (não há a formatação como data e sim geral) e a proposta por vc, tem formatação de data.

    Creio que este seja o problema em minha planilha, não sei se necessariamente tem que ter a formatação da data nas duas planilha ou se tem como funcionar com formatação diferente?

     

    sexta-feira, 28 de janeiro de 2011 02:10
  • Bom dia pessoal!

     

     

    Consegui fazer funcionar do jeito que eu queria. Criei uma estrutura em IF..ELSEIF..ENDIF e está funcionado blz.

    O código ficou grande, mas como está funcionando do jeito que eu queria, então tudo bem.

     

    Grato pela ajuda de todos.

    Fuuuiii.

    • Marcado como Resposta rsant terça-feira, 15 de março de 2011 07:53
    terça-feira, 1 de fevereiro de 2011 07:05