Macro de excel que guarde en varias hojas

Necesito crear una macro en excel que me guarde los datos que ingreso en la hoja 1, en las hojas 2, 3 y 4 segun criterios. Ejemplo:

En la HOJA 1 voy a crear un formulario de captura de datos de pacientes con sus datos principales y diagnostico, ocupo que los registros se me guarden en las diferentes hojas segun diagnostico_

NOMBRE: MARCO

IDENTIFICACION: 99999

EDAD: 39

Diagnostico: lumbalgia

EN LA HOJA 2. Ocupo que me guarde todos los registros que lleven el diagnostico LUMBALGIA

EN LA HOJA 3: Ocupo que me guarde todos los registros que lleven el diagnostico DENGUE

EN LA HOJA 4: Ocupo que me guarde todos los registros que lleven el diagnostico DIARREA

Mi correo es: [email protected]

2 Respuestas

Respuesta
2

Ante todo encantado de ayudarte a ver si te puede valer este código.

Primero suponemos que el diagnostico que vas a poner a cada paciente va en una hoja de calculo con el mismo nombre y, por otro lado supongo que en una fila tienes los encabezados de cada lista.

Por otro lado supongo que el textbox del diagnostico se llama txtDiagnostico (o como se llame), te lo pongo para que te hagas una idea luego lo adaptas a tus necesidades.

Creamos un modulo y ponemos los siguiente:

Yo lo haría de la siguiente forma, si tienes cualquier duda me comentas:

Sub RegistrarPaciente

Application.ScreenUpdating = False 'desactivamos el parpadeo de pantalla
'Creamos bucle para recorrer todas las hojas del libro
    For i = 1 To Worksheets.Count
'Si la hoja con el nombre del diagnostico en mayúsculas
'es igual que el nombre de la hoja en mayúsculas entonces
'esto lo hacemos porque se diferencia entre mayúsculas y minúsculas
        If UCase(Sheets(i).Name) = UCase(txtdiagnostico).Value Then
'La activamos
Sheets(i). Activate

            'Salimos del for
            Exit For
            
        Else 'Si no existe agregamos una hoja y le damos el nombre del diagnostico
Sheets.Add
            ActiveSheet.Name = txtdiagnostico.Value
'Agregamos los títulos en la fila 1
'con el caption de las etiquetas del formulario
'en caso de tener los títulos en las celdas referenciar las celdas
            Range("A1").Value = label1.Caption 'Nombre
            Range("A2").Value = label1.Caption 'Identificacion
            Range("A3").Value = label1.Caption 'Edad
            Range("A4").Value = label1.Caption 'Diagnostico
' 'Si quieres copiar los títulos y pegarlos de una hoja a otra
' 'con el mismo formato te dejo este código para agregar
'
' 'Seleccinamos una hoja y seleccionamos los títulos
' Sheets("Nombre de la hoja"). Activate
'            ActiveSheet.Range("A1").Select
'            Range(Selection, Selection.End(xlToRight)).Select
'
' 'Los copiamos a la hoja que acabamos de crear
' Selection. Copy Sheets(txtdiagnostico. Value). Range("A1")
'
' 'vaciamos el portapapeles
'            Application.CutCopyMode = False
            'salimos del for
            Exit For
            
        End If
        
    Next i
    
    'Una vez fuera del for copiamos los datos
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Activate
    ActiveCell.Value = Nombre 'textbox del nombre o celda donde tengas el nombre
    ActiveCell.Offset(0, 1).Value = Identificacion 'textbox o celda de la identificacion
    ActiveCell.Offset(0, 2).Value = edad ' textbox o celda de la edad
    ActiveCell.Offset(0, 3).Value = Diagnostico 'textbox o celda del diagnostico
    
    Sheets("Hoja1").Activate
    ActiveSheet.Range("A1").Select
    
    MsgBox "El paciente se ha registrado correctamente", vbInformation, "Paciente registrado"
    
    Application.ScreenUpdating = True

End Sub

Respuesta
2

H o l a 

Te paso la macro, lo que elijas en el combo diagnóstico guardará en la hoja correspondiente.

aquí el código 

Private Sub CommandButton1_Click()
If ComboBox1 = "" Or ComboBox1.ListIndex = -1 Then Exit Sub
Set h1 = Sheets(ComboBox1.ListIndex + 1)
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u, "A") = ComboBox1
h1.Cells(u, "B") = TextBox1
h1.Cells(u, "C") = Val(TextBox2)
h1.Cells(u, "D") = Val(TextBox3)
ComboBox1 = ""
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
h1.Select
MsgBox "Registrados correctamente", vbInformation
End Sub
Private Sub UserForm_Activate()
For Each hoja In Sheets
    ComboBox1.AddItem hoja.Name
Next
End Sub

Te envié el archivo 

Valora para finalizar Excelente o bueno saludos!

¡Gracias! 

H o l a

Te faltó valorar Excelente o bueno

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas