Macro para agregar filas en Excel

Me veo en la necesidad de plantearte la siguiente duda.
Tengo una hoja excel con la columna B formada por filas con datos de pacientes y la columna A con los campos de dichos datos.
Ej:
A B
NOMBRE: Perico Perez
Los campos con los que estoy trabajando, por orden, son:
Fecha:
Nombre y apellidos:
NIF:
Dirección:
Teléfono:
Enfermedades de interés:
Fármacos:
Alergias:
Intervención quirúrgica:
Mplante metálico:
Fecha lesión- tiempo molestias:
¿1º vez que va a fisio, o que le dan un masaje?:
Fecha inicio tratamiento:
Anamnesis y exploración:
Tratamiento:
Evolución:
Fecha de alta:
Nº sesiones:
Observaciones:
Estos campos se repiten para cada paciente, de forma que la hoja excel tiene mil y pico filas y sólo 2 columnas.
Resulta que los campos con los que estoy trabajando no siempre son homogénos y necesito que lo sean. Entonces lo que necesito es una macro que haga lo siguiente:
- Que busque todas las filas de la hoja excel y si falta un campo de los mencionados, cree una fila con contenido: Columna A = Campo y Columna B = Vacío.
Ejemplo:
La macro va leyendo la hoja excel y ve:
FECHA: 12/Marzo/2010
NOMBRE Y APELLIDOS: Perico Perez
NIF: 123456789A
TELÉFONO: 9855566666
Como falta el campo DIRECCIÓN, la macro creará una fila donde en la
columna A esté DIRECCIÓN: y en la columna B no haya nada.
Tal que así:
FECHA: 12/Marzo/2010
NOMBRE Y APELLIDOS: Perico Perez
NIF: 123456789A
Dirección:
TELÉFONO: 9855566666

1 respuesta

Respuesta
1
Agrega este código.
Sub Agregar_Filas()
Ciclo = Range("A65535").End(xlUp).Row
Filas = 1
Do While Filas <= Ciclo
    If Cells(Filas, 1) = "FECHA:" Then
        If Cells(Filas + 1, 1) = "NOMBRE Y APELLIDOS:" Then
            If Cells(Filas + 2, 1) = "NIF:" Then
                If Cells(Filas + 3, 1) = "DIRECCIÓN:" Then
                    If Cells(Filas + 4, 1) = "TELÉFONO:" Then
                        If Cells(Filas + 5, 1) = "ENFERMEDADES DE INTERÉS:" Then
                            If Cells(Filas + 6, 1) = "FÁRMACOS:" Then
                                If Cells(Filas + 7, 1) = "ALERGIAS:" Then
                                    If Cells(Filas + 8, 1) = "INTERVENCIÓN QUIRÚRGICA:" Then
                                        If Cells(Filas + 9, 1) = "IMPLANTE METÁLICO:" Then
                                            If Cells(Filas + 10, 1) = "FECHA LESION- TIEMPO  MOLESTIAS:" Then
                                                If Cells(Filas + 11, 1) = "¿1º VEZ QUE VA A FISIO, O QUE LE DAN UN MASAJE?:" Then
                                                    If Cells(Filas + 12, 1) = "FECHA INICIO TRATAMIENTO:" Then
                                                        If Cells(Filas + 13, 1) = "ANAMNESIS Y EXPLORACIÓN:" Then
                                                            If Cells(Filas + 14, 1) = "TRATAMIENTO:" Then
                                                                If Cells(Filas + 15, 1) = "EVOLUCIÓN:" Then
                                                                    If Cells(Filas + 16, 1) = "FECHA DE ALTA:" Then
                                                                        If Cells(Filas + 17, 1) = "Nº SESIONES:" Then
                                                                            If Cells(Filas + 18, 1) = "OBSERVACIONES:" Then
                                                                                Filas = Filas + 18
                                                                            Else
                                                                                Rows(Filas + 18 & ":" & Filas + 18).Select
                                                                                Selection.Insert Shift:=xlDown
                                                                                Cells(Filas + 18, 1) = "OBSERVACIONES:"
                                                                                Filas = 0
                                                                                Ciclo = Ciclo + 1
                                                                            End If
                                                                        Else
                                                                            Rows(Filas + 17 & ":" & Filas + 17).Select
                                                                            Selection.Insert Shift:=xlDown
                                                                            Cells(Filas + 17, 1) = "Nº SESIONES:"
                                                                            Filas = 0
                                                                            Ciclo = Ciclo + 1
                                                                        End If
                                                                    Else
                                                                        Rows(Filas + 16 & ":" & Filas + 16).Select
                                                                        Selection.Insert Shift:=xlDown
                                                                        Cells(Filas + 16, 1) = "FECHA DE ALTA:"
                                                                        Filas = 0
                                                                        Ciclo = Ciclo + 1
                                                                    End If
                                                                Else
                                                                    Rows(Filas + 15 & ":" & Filas + 15).Select
                                                                    Selection.Insert Shift:=xlDown
                                                                    Cells(Filas + 15, 1) = "EVOLUCIÓN:"
                                                                    Filas = 0
                                                                    Ciclo = Ciclo + 1
                                                                End If
                                                            Else
                                                                Rows(Filas + 14 & ":" & Filas + 14).Select
                                                                Selection.Insert Shift:=xlDown
                                                                Cells(Filas + 14, 1) = "TRATAMIENTO:"
                                                                Filas = 0
                                                                Ciclo = Ciclo + 1
                                                            End If
                                                        Else
                                                            Rows(Filas + 13 & ":" & Filas + 13).Select
                                                            Selection.Insert Shift:=xlDown
                                                            Cells(Filas + 13, 1) = "ANAMNESIS Y EXPLORACIÓN:"
                                                            Filas = 0
                                                            Ciclo = Ciclo + 1
                                                        End If
                                                    Else
                                                        Rows(Filas + 12 & ":" & Filas + 12).Select
                                                        Selection.Insert Shift:=xlDown
                                                        Cells(Filas + 12, 1) = "FECHA INICIO TRATAMIENTO:"
                                                        Filas = 0
                                                        Ciclo = Ciclo + 1
                                                    End If
                                                Else
                                                    Rows(Filas + 11 & ":" & Filas + 11).Select
                                                    Selection.Insert Shift:=xlDown
                                                    Cells(Filas + 11, 1) = "¿1º VEZ QUE VA A FISIO, O QUE LE DAN UN MASAJE?:"
                                                    Filas = 0
                                                    Ciclo = Ciclo + 1
                                                End If
                                            Else
                                                Rows(Filas + 10 & ":" & Filas + 10).Select
                                                Selection.Insert Shift:=xlDown
                                                Cells(Filas + 10, 1) = "FECHA LESION- TIEMPO  MOLESTIAS:"
                                                Filas = 0
                                                Ciclo = Ciclo + 1
                                            End If
                                        Else
                                            Rows(Filas + 9 & ":" & Filas + 9).Select
                                            Selection.Insert Shift:=xlDown
                                            Cells(Filas + 9, 1) = "IMPLANTE METÁLICO:"
                                            Filas = 0
                                            Ciclo = Ciclo + 1
                                        End If
                                    Else
                                        Rows(Filas + 8 & ":" & Filas + 8).Select
                                        Selection.Insert Shift:=xlDown
                                        Cells(Filas + 8, 1) = "INTERVENCIÓN QUIRÚRGICA:"
                                        Filas = 0
                                        Ciclo = Ciclo + 1
                                    End If
                                Else
                                    Rows(Filas + 7 & ":" & Filas + 7).Select
                                    Selection.Insert Shift:=xlDown
                                    Cells(Filas + 7, 1) = "ALERGIAS:"
                                    Filas = 0
                                    Ciclo = Ciclo + 1
                                End If
                            Else
                                Rows(Filas + 6 & ":" & Filas + 6).Select
                                Selection.Insert Shift:=xlDown
                                Cells(Filas + 6, 1) = "FÁRMACOS:"
                                Filas = 0
                                Ciclo = Ciclo + 1
                            End If
                        Else
                            Rows(Filas + 5 & ":" & Filas + 5).Select
                            Selection.Insert Shift:=xlDown
                            Cells(Filas + 5, 1) = "ENFERMEDADES DE INTERÉS:"
                            Filas = 0
                            Ciclo = Ciclo + 1
                        End If
                    Else
                        Rows(Filas + 4 & ":" & Filas + 4).Select
                        Selection.Insert Shift:=xlDown
                        Cells(Filas + 4, 1) = "TELÉFONO:"
                        Filas = 0
                        Ciclo = Ciclo + 1
                    End If
                Else
                    Rows(Filas + 3 & ":" & Filas + 3).Select
                    Selection.Insert Shift:=xlDown
                    Cells(Filas + 3, 1) = "DIRECCIÓN:"
                    Filas = 0
                    Ciclo = Ciclo + 1
                End If
            Else
                Rows(Filas + 2 & ":" & Filas + 2).Select
                Selection.Insert Shift:=xlDown
                Cells(Filas + 2, 1) = "NIF:"
                Filas = 0
                Ciclo = Ciclo + 1
            End If
        Else
            Rows(Filas + 1 & ":" & Filas + 1).Select
            Selection.Insert Shift:=xlDown
            Cells(Filas + 1, 1) = "NOMBRE Y APELLIDOS:"
            Filas = 0
            Ciclo = Ciclo + 1
        End If
    Else
        Rows(Filas & ":" & Filas).Select
        Selection.Insert Shift:=xlDown
        Cells(Filas, 1) = "FECHA:"
        Filas = 0
        Ciclo = Ciclo + 1
    End If
    Filas = Filas + 1
Loop
End Sub
Espero que sea de tu ayuda. Cualquier consulta no dudes en preguntar.
Suerte
Pitcher !
A y no olvides cerrar la pregunta si la respuesta fue de tu ayuda.
Donde pone mplante metálico, debería poner realmente IMPLANTE METÁLICO:
Perdón por el error. Un saludo.
Hola Pitcher,
La solución ha sido fantástica y ha sobrepasado mis expectativas puesto que gracias a ella he detectado lineas erróneas en la base de datos y he podido corregirlas. 10 sobre 10.
Muchísimas gracias amigo. Recibe un cordial saludo,
Bricomatica.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Macro de excel para insertar filas

Agradezco si alguien me puede ayudar con una macro, para insertar filas en excel, tengo la siguiente, Sub Macro1() Dim Filas As Single, MiRango As Object Filas = ActiveCell.Value2 Set MiRango = Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Filas,...
1 respuesta

Macro para buscar valor "#N/A" en una columna

Me podrían ayudar con esta macro, Tengo una macro que me genera un reporte de inventario en un archivo excel, el archivo tiene códigos y formulas para la descripción de cada código, Ejemplo. Código descripción 001 zanahorias. 002 cebollas. 003...
1 respuesta

Macro para bajar renglones

Me podrías ayudar con una macro que realize la siguiente función: Tengo un useform que pone datos en la celdas, y le hice un botón de aceptar, lo que quiero que haga ese botón es que me pocisione en la siguiente celda, por ejemplo: Escribo datos en...
2 respuestas

Inserción de filas en Excel mediante VBA

Resulta que necesito saber como puedo crear en prima instancia una fila cuando un usuario de clic sobre los números que estén en la parte superior izquierda de la hoja de calculo... Con la grabadora de Macroshago el proceso y me genera el siguiente...
2 respuestas

Macro para insertar fila según valor de una celda

Tengo dos columnas F Y G F TIENE mis Datos y G tiene las veces que quiero insertar una fila con la Informacion de toda la fila de F Franja Row F01 0 F02 2 Lo que deberia quedar F01 0 F02 F02 Y asi sucesivamente hasta encontrar una celda ""
1 respuesta

Macro no funciona todas las computadoras

Otra vez acudo a tu gran ayuda y conocimiento, no se si recuerdas mi primera macro la cual era la distribución de Estados partiendo de una BD y extendiéndose en todas las hojas dependiendo del nombre de la misma. Algo curioso y que aun no eh podido...
1 respuesta

Eliminar filas con macro

Tengo una tabla con el número de alumnos de una escuela. En la 1º columna está el curso (1º Año, 2º Año, etc.), en la 2º columna, está la cantidad de varones, en 3º la cantidad de mujeres y en la 4º el total. Mi duda es si se puede hacer una macro...
2 respuestas

Macro formato de fecha

Quería ver si me pueden ayudar en lo siguiente, tengo la fecha en las columnas "F:F" y "G:G" y están de la siguiente forma 21/03/12. Estas fechas las extraigo de un archivo txt algunas me las muestra con formato completo es decir 21/03/2012 y otras...
1 respuesta

Ayuda con código visual basic (userform)

Gracias por tomarse la molestia de leer mi duda pero ya llevo días y no consigo hacer que funcione. Tengo una hoja en excel 2010 llamada "Captura" con columnas desde "A" hasta "-k-" y las filas son variables debido a que van aumentando conforme se...
1 respuesta

Importar de un datagrid a mysql

Disculpa pero tengo problemas con insertar datos en mi tabla en mysql tengo el siguiente código el cual recorre mi datagrid el cual contiene lo datos que voy a insertar 'Definimos dos arrays de String, C,f y t, que contendrn, respectivamente, los...
1 respuesta