Macro para informes diarios
Tengo una tabla (la hoja se llama VENTAS ACTIVIDADES), con todas las actividades que voy vendiendo, esta tabla tiene 19 columnas(Fecha de actividad, Hora, Actividad, Nombre del cliente, Tlf...). Aquí almaceno todos los datos de las actividades que vendo diariamente. Y ahora quisiera, (por ejemplo en la hoja 3), crear un Userform que me pida una fecha y sacar todas las actividades que tengo ese día. Quiero que me saque varios datos de los que tengo en la hoja de VENTAS ACTIVIDADES (Hora, Actividad, Nombre del Cliente...), lo que llamamos un Informe diario.
Los datos de VENTAS ACTIVIDADES, no están ordenadas por fechas. Según vendo la actividad se graba en la tabla.
He intentado varias cosas, pero no he conseguido nada... De momento lo hago usando VBUSCAR, pero cuando el informe lo saca otra persona me borra todas las fórmulas... NECESITO UNA MACRO!.
3 respuestas
Mejor mándame tu archivo con los datos con un ejemplo de lo que quieres. Así podré trabajar sobre él y mandarte una solución
Dibuja un botón en tu hoja de informe diario y adjudicale esta macro. A mi parecer no es necesario un userform para eso:
Sub informe_diario()
'por luismondelo
datof = InputBox("introduzca la fecha de petición")
If Not IsDate(datof) Then Exit Sub
ubica1 = Mid(datof, 3, 1)
ubica2 = Mid(datof, 6, 1)
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox "La fecha introducida no es válida. Solo se acepta este formato: dd/mm/aaaa"
Exit Sub
End If
For Each celda In Sheets("BASE DE DATOS RESERVA").Range("g1:g" & Sheets("BASE DE DATOS RESERVA").Range("g65000").End(xlUp).Row)
If celda Like f Then
Celda.Offset(0, 2). Copy
Sheets("INFORME DIARIO"). Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -5). Copy
Sheets("INFORME DIARIO"). Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -1). Copy
Sheets("INFORME DIARIO"). Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -4). Copy
Sheets("INFORME DIARIO"). Range("d65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -3). Copy
Sheets("INFORME DIARIO"). Range("e65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 4). Copy
Sheets("INFORME DIARIO"). Range("f65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 8). Copy
Sheets("INFORME DIARIO"). Range("g65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 9). Copy
Sheets("INFORME DIARIO"). Range("h65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda. Offset(0, 10). Copy
Sheets("INFORME DIARIO"). Range("i65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 3). Copy
Sheets("INFORME DIARIO"). Range("j65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda. Offset(0, 12). Copy
Sheets("INFORME DIARIO"). Range("k65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
Next
End Sub
Perdona la macro tenía un error ortográfico
Es esta:
Sub informe_diario()
'por luismondelo
datof = InputBox("introduzca la fecha de petición")
If Not IsDate(datof) Then Exit Sub
ubica1 = Mid(datof, 3, 1)
ubica2 = Mid(datof, 6, 1)
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox "La fecha introducida no es válida. Solo se acepta este formato: dd/mm/aaaa"
Exit Sub
End If
For Each celda In Sheets("BASE DE DATOS RESERVA").Range("g1:g" & Sheets("BASE DE DATOS RESERVA").Range("g65000").End(xlUp).Row)
If celda Like datof Then
Celda.Offset(0, 2). Copy
Sheets("INFORME DIARIO"). Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -5). Copy
Sheets("INFORME DIARIO"). Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -1). Copy
Sheets("INFORME DIARIO"). Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -4). Copy
Sheets("INFORME DIARIO"). Range("d65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, -3). Copy
Sheets("INFORME DIARIO"). Range("e65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 4). Copy
Sheets("INFORME DIARIO"). Range("f65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 8). Copy
Sheets("INFORME DIARIO"). Range("g65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 9). Copy
Sheets("INFORME DIARIO"). Range("h65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda. Offset(0, 10). Copy
Sheets("INFORME DIARIO"). Range("i65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda.Offset(0, 3). Copy
Sheets("INFORME DIARIO"). Range("j65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
celda. Offset(0, 12). Copy
Sheets("INFORME DIARIO"). Range("k65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
Next
End Sub
Muchísimas gracias por responder tan rápido. Voy a probarlo y te cuento, como me ha ido.
Hola Luis. Al principio me salía un error en la función Mid, le cambie a VBA.mid y desapareció el error. Pero ahora me sale otro nuevo:"se ha producido el error 13 en compilación: No coinciden los tipos".
Puede ser un error al declarar las variables ???? celda la declare como range...puede venir de ahí el error???. Ayudame por favor, que estoy muy, muy perdida.
Gracias.
En el editor de visual basic pulsa en HERRAMIENTAS----REFERENCIAS y aparecerá esta imagen
Quita el pincho al renglón donde dice falta y prueba después
http://www.programarexcel.com/2014/01/recorre-hojas-extrae-datos-para-resumen.html
Ahí tienes unos ejemplos que te pueden servir