Filtrar datos y Guardar como Imagen
Para Dante. Disculpa la molesta de nuevo.
Necesito ayuda sobre una macro en Vba
Te comento
Tengo 1 hoja en excel.
La primera hoja estan los datos registrados
A1 Los Titulos (Nombre - Cedula Identidad - Cargo - Fecha - etc)
A2:F∞ (hasta donde haya datos, puede variar)
Y quiero saber si no me pones ayudar con una macro que haga lo siguiente:
- *Que me filtre los datos de la semana en que estamos (si hoy es ejecutado la macro que me filtre los datos de esta semana)
- *me los copie a otra hoja los datos filtrados (con el encabezado)
- y que me exporte en formato Jpg los datos que se copio en la otra hoja.
- Y despues elimine el filtro. (Para dejar como estaba)
ejemplo:
Que me filtren los datos que estan en la Hoja "datos"
Luego que copie los datos filtrados en la hoja "Filtrado"
Y que me exporte los datos de la hoja "Filtrada"
Desde ya te agradesco o les agradesco si alguien mas aporta su ayuda ayuda
1 respuesta
Te anexo la macro con 2 peticiones:
1. Filtrar los registros de la semana actual (domingo a sábado).
2. Copiar los datos filtrados como imagen, guarda la imagen como jpeg y le pone como nombre de archivo el número de semana actual.
Sub FiltroSemana()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("datos")
Set h2 = Sheets("filtrado")
h2.Cells.Clear
'
h1.[A1].AutoFilter
u = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("A1:F" & u).AutoFilter Field:=4, _
Criteria1:=xlFilterThisWeek, Operator:=xlFilterDynamic
h1.Range("A1:F" & u).Copy
h2.[A1].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
h1.Application.CutCopyMode = False
h1.[A1].AutoFilter
h1.Select
[A1].Select
'
ruta = ThisWorkbook.Path & "\"
arch = Application.WeekNum(Date) & ".JPEG"
'
Set h3 = Sheets.Add
h3.Shapes.AddChart
u2 = h2.Range("D" & Rows.Count).End(xlUp).Row
h2.Range("A1:F" & u2).CopyPicture
h3.ChartObjects(1).Select
With Selection
.Height = h2.Range("A1:F" & u2).Height
.Width = h2.Range("A1:F" & u2).Width
.Chart.Paste
.Chart.Export ruta & arch
End With
h3.Delete
MsgBox "Terminado"
End SubSaludos.Dante Amor
