seleccionar varios registros por fecha

On 26 nov, 17:19, Jumpas wrote:

Tengo una hoja con una lista de facturas en las que tengo
Fecha - Nº factura - Cliente - Importe

las facturas son de todo el año y lo que intento es que en otra hoja (Enero)
seleccionar todas las facturas que sean del mes de enero, otra hoja para
Febrero y asi sucesivamente para los doce meses.

las facturas estan ordenadas por fecha y por numero de factura

Agradezco cualquier ayuda que me puedan aportar, gracias

Buenas tardes.

Te he preparado una macro que funciona con las siguientes
restricciones:

- la hoja con la lista de facturas tiene las cuatro columnas indicadas
(sin información adicional en el resto de columnas)
- la primera fila contiene el nombre de los campos y la segunda el
primer registro de datos.
- las pestañas enero-diciembre existen

Operativa de la macro:

1- añade columna mes
2- añade columnas para extraer información de filtro avanzado
3- inicia un bucle que extrae la información del mes y la pega en la
pestaña que corresponde
4- elimina las columnas creadas al finalizar la ejecución

Esta macro es la siguiente:


Sub llevar_a_meses()
bdat = ActiveSheet.Name
Range("E1").Value = "mes"
a = Range("a1").CurrentRegion.Rows.Count
With Range("E2")
.FormulaR1C1 = "=MONTH(RC[-4])"
.Copy
End With
Range("E2:E" & a).PasteSpecial (xlPasteAll)
Range("D1").Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Range("M1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For mes = 1 To 12
[M2].Value = mes
Range("A1").CurrentRegion.Select
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:=Range _
("M1:M2"), CopyToRange:=Range("G1:K1"), Unique:=False
Range("G1:J1").EntireColumn.Copy
Sheets(Format(DateSerial(2009, mes, 1), "mmmm")).Activate
Range("A1").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
Sheets("bdat").Activate
Next
Range("E1:M1").EntireColumn.Delete
End Sub


Saludos,

Benito