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

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 ActiveSheetSet 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 SubAgradeço a colaboração.
Abraço
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
-
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
-