Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Exportação com filt...
 
Notifications
Clear all

Exportação com filtro

 
2024 - VBA & Macros
Post Recente por orakulo 9 anos atrás
8 Posts
3 Usuários
0 Reactions
1,141 Visualizações
RSS
 orakulo
(@orakulo)
Posts: 7
Active Member
Topic starter
 

Bom dia Amigos, tenho mais uma dúvida.
Utilizo o código abaixo para exportar algumas colunas que quero, para outra planilha.
Gostaria de ir um pouco adiante e filtrar as linhas das colunas que serão copiadas. Um exemplo:
Coluna A é a coluna que contem as dadas, gostaria de informar antes o intervalo de linhas que preciso que exporte, 01/10/2015 até 30/10/2015 dai exportaria essas linhas com as colunas do código.

Sub Copiar_Dados()
Dim wsOrigem As Worksheet
Dim wsDestino As Worksheet

'Arquivo Destino, abrimos primeiro
'Ajuste o caminho do mesmo
Workbooks.Open Filename:="C:UsersPc53DesktopV 1Rel.xlsx"

'Arquivos e Abas de Origem e Destino
Set wsOrigem = Workbooks("Pedido de Venda_.xlsm").Worksheets("dados")
Set wsDestino = Workbooks("Rel.xlsx").Worksheets("Plan1")

With wsOrigem
.Range("A1:A1000").Copy Destination:=wsDestino.Range("A1")
.Range("B1:B1000").Copy Destination:=wsDestino.Range("B1")
.Range("AE1:AE1000").Copy Destination:=wsDestino.Range("C1")
.Range("AF1:AF1000").Copy Destination:=wsDestino.Range("D1")
.Range("AL1:AL1000").Copy Destination:=wsDestino.Range("E1")
.Range("AZ1:AZ1000").Copy Destination:=wsDestino.Range("F1")
.Range("BA1:BA1000").Copy Destination:=wsDestino.Range("G1")
.Range("BG1:BG1000").Copy Destination:=wsDestino.Range("H1")
.Range("BU1:BU1000").Copy Destination:=wsDestino.Range("I1")
.Range("BV1:BV1000").Copy Destination:=wsDestino.Range("J1")
.Range("CB1:CB1000").Copy Destination:=wsDestino.Range("K1")
.Range("CZ1:CZ1000").Copy Destination:=wsDestino.Range("L1")
.Range("DA1:DA1000").Copy Destination:=wsDestino.Range("M1")
.Range("DB1:DB1000").Copy Destination:=wsDestino.Range("N1")
End With
'Fecha o Arquivo Destino e Salva
Workbooks("Rel.xlsx").Close SaveChanges:=True

MsgBox "Introdução de Dados Concluída"
End Sub

 
Postado : 13/10/2015 7:16 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Vamos considerar que você vai fazer o filtro no excel, após isso usar a sua macro com a linha abaixo adaptada...
Você já tentou usar essa linha 

.UsedRange.SpecialCells(xlCellTypeVisible).Copy

?

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 13/10/2015 7:39 am
 setti
(@setti)
Posts: 150
Estimable Member
 

VEJA SE É ISSO

 
Postado : 13/10/2015 8:17 am
 setti
(@setti)
Posts: 150
Estimable Member
 

VEJA SE É ISTO

 
Postado : 13/10/2015 8:27 am
 orakulo
(@orakulo)
Posts: 7
Active Member
Topic starter
 

VEJA SE É ISTO

Esta dando erro em tempo de execução 13 na linha

linha = Sheets(wsOrigem).Cells(Rows.Count, "A").End(xlUp).Offset(0, 0).Row

 
Postado : 13/10/2015 10:25 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Você tentou minha sugestão!!

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 13/10/2015 10:55 am
 setti
(@setti)
Posts: 150
Estimable Member
 

veja agora!!!

 
Postado : 13/10/2015 12:28 pm
 orakulo
(@orakulo)
Posts: 7
Active Member
Topic starter
 

veja agora!!!

Excelente !

Faltou alguns detalhes:
Faltou declarar as variáveis data3 e data4, ficando assim :
Dim data1, data2, data3, data4 As Date

Para complementar vi que é feita a cópia das linhas no destino, na mesma posição da origem e dependendo do intervalo os registros ficam com varias linhas em branco acima, para resolver isso, usei a função:

Sub apagaLinhaBranco()
Columns("A:A").Select 'Adapte para a coluna que quiser
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End Sub

 
Postado : 14/10/2015 5:04 am
Forum Jump:
  Tópico Anterior
Próximo Tópico