none
Macro Copiar de uma Planilha e Colar em Outra com Condição. RRS feed

  • Pergunta

  • Prezados, boa tarde.

    Estou precisando de uma ajuda para montar o código de uma macro que copie os dados de uma outra planilha com a condição da data ser a mesma do mês que estamos e também estar escrito "Aprovada" ou "Aprovada, em partes" em outra célula, por exemplo:

    Estamos no mês 9, então a macro abre a planilha destino que eu escolher e vai até a Sheet que eu definir e começa a contar a partir da linha que eu definir também. Se a primeira célula da coluna D for equivalente ao mês que nós estamos e ná célula da coluna E estiver escrito "Aprovada" ou "Aprovada, em partes", ela copia a primeira célula para a planilha de origem e vai para a próxima linha..

    OBS: Algumas células que serão copiadas (Coluna A + B) estão mescladas. Não sei se isso é um problema.

    Eu comecei a fazer um código mas acredito estar longe do sucesso.

    Segue:

    Sub BuscarInformações()
     'Variáveis
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim Rng As Excel.Range
      Dim twb As Variant
      Dim a As Variant
      Dim lngLast As Long
      Dim i As Integer
     
      With ThisWorkbook
            Set wksData = .Worksheets("Relatório Posição Faturamento")
                End With

            'Abre a planilha escolhida e vai direto para a Sheet "Propostas Comerciais".
       With ActiveSheet

          Set wb = Workbooks.Open(Application.GetOpenFilename)
          Set ws = wb.Sheets(5)
          Application.Goto ws.Range("A4")
          lngLast = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      End With
      
        For i = 4 To lngLast
           
        Application.Goto ws.Range("A" & i)
        Selection.Copy
        Application.Goto wksData.Range("A13").Paste
       
        Next i
            
      Set ws = Nothing
      Set wb = Nothing
      Application.ScreenUpdating = True
    End Sub

    Agradeço a colaboração.


    Abraço

    terça-feira, 23 de setembro de 2014 18:00

Todas as Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.

    ---

    Sobre sua dúvida, imagino que você esteja em dúvida apenas na parte final do código, não?

    Sub BuscarInformações()
      'Variáveis
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim Rng As Excel.Range
      Dim twb As Variant
      Dim a As Variant
      Dim lngLast As Long
      Dim i As Integer
      Dim wksData As Excel.Worksheet
      
      With ThisWorkbook
        Set wksData = .Worksheets("Relatório Posição Faturamento")
      End With
      
      'Abre a planilha escolhida e vai direto para a Sheet "Propostas Comerciais".
      With ActiveSheet 'Seria melhor colocar o nome específico da planilha aqui, não?
        
        Set wb = Workbooks.Open(Application.GetOpenFilename)
        Set ws = wb.Sheets(5)
        Application.Goto ws.Range("A4")
        lngLast = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      End With
      
      For i = 4 To lngLast
        'Apenas linhas que possuem 'Aprovada' numa célula da coluna (por exemplo) C serão copiadas:
        If ws.Cells(i, "C") Like "Aprovada*" Then
          ws.Rows(i).Copy wksData.Range("A13")
        End If
      Next i
      
      Set ws = Nothing
      Set wb = Nothing
      Application.ScreenUpdating = True
    End Sub
    
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 23 de setembro de 2014 22:26
    Moderador
  • Ahh desculpe pela maneira errada de postar e obrigado pela informação.

    Felipe, obrigado também pela ajuda.

    Na verdade eu consegui fazer o código que eu queria porém se o IF de condição na coluna E de "Aprovado" ou "Aprovado, em partes" e que também a data da coluna D seja a mesma do nosso mês atual.

    Segue o código que eu fiz para melhor entendimento.

    Sub BuscarInformações()
     'Variáveis
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim Rng As Excel.Range
      Dim twb As Variant
      Dim a As Variant
      Dim lngLast As Long
      Dim i As Integer
      
      Application.ScreenUpdating = False
      
      With ThisWorkbook
            Set wksData = .Worksheets("Relatório Posição Faturamento")
                End With
    
            'Abre a planilha escolhida e vai direto para a Sheet "Propostas Comerciais".
       With ActiveSheet
    
          Set wb = Workbooks.Open(Application.GetOpenFilename)
          Set ws = wb.Sheets(5)
          lngLast = Range("A" & Rows.Count).End(xlUp).Row
      End With
       
    
     *'AQUI ENTRARIA O IF DA COLUNA E COM A CONDIÇÂO DE "Aprovada" ou "Aprovada, em partes" E TAMBÉM A CONDIÇÃO DA DATA DACOLUNA D SER A DO MÊS ATUAL
      
    'Começa a partir da linha 71, pois as informações antigas são descartadas
        For i = 71 To lngLast
            
        Application.Goto ws.Range("A" & i)
        Selection.Copy
        Application.Goto wksData.Range("a" & i - 58)
        ActiveSheet.Paste
        Range("a" & i - 58).Select
        Application.Goto ws.Range("b" & i)
        Selection.Copy
        Application.Goto wksData.Range("b" & i - 58)
        ActiveSheet.Paste
        Range("b" & i - 58).Select
        Application.Goto ws.Range("c" & i)
        Selection.Copy
        Application.Goto wksData.Range("c" & i - 58)
        ActiveSheet.Paste
        Range("c" & i - 58).Select
        ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
        
    
        Next i
             
      Set ws = Nothing
      Set wb = Nothing
      Application.ScreenUpdating = True
    End Sub
    

    quarta-feira, 24 de setembro de 2014 12:38
  • Não entendi sua última postagem. Qual é sua d´vuda?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 2 de outubro de 2014 22:14
    Moderador