Buenos días, voy a intentar explicarme claramente ya que mi duda es para nivel avanzado de excel.
Estoy generando una base de datos y dentro del mismo documento excel tengo tres hojas de excel. Estas hojas se caracterizan por tener las cuatro primeras filas iguales (nombre de empleado, tipo de contrato...) y la información del resto de filas va asociada a la información que en esa hoja de recopila. (revisión médica, formación...). Cada vez que tenemos un alta o una baja en la empresa tengo que hacer la labor de introducir en las tres hojas la misma información de datos del trabajador.
He probado a vincular las celdas de una hoja a otra pero el problema es que cuando uso los filtros de las hojas la información se desordena...
Mi pregunta es... De qué manera podría trabajar con estas cuatro columnas como fijas pero a la vez que cuando usara filtros estuviera todo vinculado y la infomación no se desordenara?
Saludos y gracias de antemano.
1 Respuesta
Para entender mejor lo que necesitas, podrías elaborar unos ejemplos de cómo tienes la información en tus 3 hojas, me explicas cuáles son los pasos que realizas, para que yo, con los ejemplos que me estás enviando reproduzca la secuencia de esos pasos, y por último, si gustas en otra hoja, me explicas cómo quieres que quede la información.
Hola Dante;
Ya te he enviado vía mail un ejemplo de la tabla Excel que uso habitualmente.
Saludos
Te envié el archivo con esta macro, prueba el funcionamiento y me comentas
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("A:A, C:C, D:D")) Is Nothing Then
Application.ScreenUpdating = False
Set h2 = Sheets("EPI's")
Set h3 = Sheets("REV.MÉDICA")
If Cells(Target.Row, "B") = "" Then Exit Sub
Set b = h2.Range("B:B").Find(Cells(Target.Row, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Range("A" & b.Row) = Range("A" & Target.Row)
h2.Range("C" & b.Row) = Range("C" & Target.Row)
h2.Range("D" & b.Row) = Range("D" & Target.Row)
Else
Range("A" & Target.Row & ":D" & Target.Row).Copy
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & u).PasteSpecial
Application.CutCopyMode = False
End If
Set b = h3.Range("B:B").Find(Cells(Target.Row, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h3.Range("A" & b.Row) = Range("A" & Target.Row)
h3.Range("C" & b.Row) = Range("C" & Target.Row)
h3.Range("D" & b.Row) = Range("D" & Target.Row)
Else
Range("A" & Target.Row & ":D" & Target.Row).Copy
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Range("A" & u).PasteSpecial
Application.CutCopyMode = False
End If
End If
End Sub
Te anexo la macro con la actualización
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("A:A, C:C, D:D")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Set h2 = Sheets("EPI's")
Set h3 = Sheets("REV.MÉDICA")
If Cells(Target.Row, "B") = "" Then
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End If
Set b = h2.Range("B:B").Find(Cells(Target.Row, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Range("A" & b.Row) = Range("A" & Target.Row)
h2.Range("C" & b.Row) = Range("C" & Target.Row)
h2.Range("D" & b.Row) = Range("D" & Target.Row)
Else
Range("A" & Target.Row & ":D" & Target.Row).Copy
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & u).PasteSpecial
Application.CutCopyMode = False
End If
Set b = h3.Range("B:B").Find(Cells(Target.Row, "B"), lookat:=xlWhole)
If Not b Is Nothing Then
h3.Range("A" & b.Row) = Range("A" & Target.Row)
h3.Range("C" & b.Row) = Range("C" & Target.Row)
h3.Range("D" & b.Row) = Range("D" & Target.Row)
Else
Range("A" & Target.Row & ":D" & Target.Row).Copy
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Range("A" & u).PasteSpecial
Application.CutCopyMode = False
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End SubNo olvides valorar la respuesta.
