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

Question

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

Answer 1

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

Answer 2

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

Answer 3

Não entendi sua última postagem. Qual é sua d´vuda?

---

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