En este articulo, realizamos un ejercicio para practicar un poco la instruccion Find, y los bucles, asi como el copiar de hoja a hoja. Para ello vamos a utilizar una hoja de calculo con la lista de notas de alumnos en tres asignaturas, y obtenemos una hoja por asignatura con todos los alumnos, mas una hoja por alumno con las notas de todas las asignaturas.
Ya os aviso que el desarrollo se hace con fines didacticos, por lo que no esta optimizado para produccion, ni en tiempos, ni en instrucciones. Vamos paso a paso para facilitar el aprendizaje.
Ahora os presento como es la hoja de calculo de la que partiremos.
A continuación, os muestro como queda la macro, (miMacro) y las tres subrutinas que utilizamos para realizar el trabajo. Conque las copiéis a un módulo en el mismo libro que los datos de la hoja de la imagen superior, podéis lanzar la macro y veréis como funciona.
Ah!, una cosa, a la primera hoja le habeis de cambiar el nombre, y ponerle «notas»
Sub copiarNombres() Sheets("notas").Activate Range("A5:" & Range("A5").End(xlDown).Address).Select Selection.Copy End Sub Sub miMacro() crearHoja "Word" crearHoja "access" crearHoja "Excel" alumnos End Sub Sub crearHoja(nombre As String) Set hojaNueva = Sheets.Add(After:=Sheets(Sheets.Count)) hojaNueva.Name = nombre copiarNombres hojaNueva.Activate Range("A3").Select ActiveSheet.Paste Sheets("notas").Activate Set origen = ActiveSheet.Rows(5).Find(nombre) If Not origen Is Nothing Then Range(origen, origen.End(xlDown)).Copy hojaNueva.Activate Range("B3").Select ActiveSheet.Paste End If End Sub Sub alumnos() Dim area As Range Dim celda As Range Dim hojaNueva As Worksheet Set area = Range("A6:" & Range("A6").End(xlDown).Address).Cells For Each celda In area Set hojaNueva = Sheets.Add(After:=Sheets(Sheets.Count)) hojaNueva.Name = celda.Value ThisWorkbook.Activate hojaNueva.Cells(1, 1).Value = celda.Value hojaNueva.Cells(3, 6).Value = "word" hojaNueva.Cells(3, 7).Value = celda.Offset(0, 1) hojaNueva.Cells(5, 6).Value = "access" hojaNueva.Cells(5, 7).Value = celda.Offset(0, 2) hojaNueva.Cells(7, 6).Value = "excel" hojaNueva.Cells(7, 7).Value = celda.Offset(0, 3) Next End Sub
Y ahora las explicaciones.
Si os fijáis, la rutina principal «miMacro» se limita a realizar llamadas a las rutinas que realizan el trabajo, que son dos la rutina crearHoja que espera un nombre de hoja ,crea dicha hoja y mueve la columna de notas con el mismo nombre, y la rutina alumnos que se encarga de recorrer la tabla de alumnos y va creando una hoja para cada uno.
Rutina CrearHoja
Esta rutina recibe el nombre de la hoja a crear, que deberá ser uno de los títulos de las columnas de notas (Word,Excel o Access), en sus dos primeras lineas, crea una hoja nueva, y le asigna el nombre que le han pasado. A continuación llama a la subrutina copiarNombres.
La subrutina copiarNombres, se limita a posicionarse en la hoja «notas», la primera, y selecciona a partir de A5 y hasta la primera celda en blanco(Range(«A5»).End(xlDown)).
Lo hace estableciendo el Range, y despues ejecutando Select. Por ultimo, copia el rango en el portapapeles y lo deja preparado para copiar.
A la vuelta activa la hoja de destino, se posiciona en la celda en donde desea copiar la lista de nombres, y los pega con la orden Paste, desde el portapapeles.
Sheets(«notas»).Activate
Set origen = ActiveSheet.Rows(5).Find(nombre)
se posiciona nuevamente en la hoja inicial, y busca en la fila 5 el nombre que le han pasado. Si lo encuentra, realiza la selección hasta la primera celda en blanco, lo copia, se vuelve a la hoja de destino y lo pega.
Esta subrutina sera llamada para cada una de las columnas que se desea copiar, y nos quedará resuelta la primera parte.
La subrutina alumnos
Para la segunda parte, la generación de una hoja por alumno con sus resultados, utilizamos la subrutina alumnos
Se posiciona en la primera celda de alumnos, y crea un rango hasta la primera celda en blanco
Set area = Range(«A6:» & Range(«A6»).End(xlDown).Address).Cells
La terminación Cells, hace que extraiga del rango, la colección de celdas, y me queden en area
Todas las demás sentencias se hacen para cada una de las celdas, ya que
For Each celda In area
ira depositando en celda una celda de la colección, a cada pasada. Esto es, iré avanzando linea a linea, y, para cada linea:
Creo la hoja del alumno, y le asigno su nombre
Set hojaNueva = Sheets.Add(After:=Sheets(Sheets.Count))
hojaNueva.Name = celda.Value
A continuación muevo la información que deseo, para ello, recordad que celda es precisamente la celda que contiene el nombre del alumno, por lo que con Offset, desplazo el punto de recogida a la columna de notas (1 para Word, 2 para Access, y 3 para Excel)
hojaNueva.Cells(1, 1).Value = celda.Value
hojaNueva.Cells(3, 6).Value = «word»
hojaNueva.Cells(3, 7).Value = celda.Offset(0, 1)
hojaNueva.Cells(5, 6).Value = «access»
hojaNueva.Cells(5, 7).Value = celda.Offset(0, 2)
hojaNueva.Cells(7, 6).Value = «excel»
hojaNueva.Cells(7, 7).Value = celda.Offset(0, 3)
El punto de destino es la hoja recién creada,por la que me muevo por coordenadas convencionales (fila, columna)….
y ya esta todo explicado; espero que os haya servido para conocer un poco mas las macros
8 comentarios
Eres genial explicando deberías hacer tutoriales en youtube, y si ya los haces pasame la liga para suscribirme, gracias por tu explicación.
Gracias por tus alabanzas, el problema es que a mi me gusta mas leer un tutorial que verlo, ya que me permite mejor adaptarlo a mis conocimientos, lo que se, lo leo rápido, lo que no, lento…Por eso no hago nada en YouTube