Convertir múltiples columnas a registros (filas)

Luis, antes que nada un afectuoso saludo.
Gracias por compartirnos tus conocimientos.

Veras, mi pregunta va enfocada a lo siguiente:

Antecedente: Tengo un archivo en excel con varias columnas, en ellas están encabezados como:
Apellido Paterno - Apellido Materno - Nombre - Nota - Fecha1 - Fecha2 - Fecha3 - Etc.

El detalle es que en las columnas llamadas Fecha1-Fecha2-Fecha3 y las subsecuentes se trata de la misma persona y se van creando mas columnas de acuerdo a las siguientes visitas que realiza, esto es, si la persona llegase a venir 50 veces, existirán 50 columnas pero con una sola fila. Yo quiero pasar ese archivo de excel a access, pero imaginate, me va a crear mas de 50 campos (uno por cada columna).

La pregunta es:

Como hacer para que dependiendo del numero de las columnas llamadas fecha1-fecha2-etc se generen el mismo numero de registros (filas). Yo llamare a fecha1-fecha2 como fecha.

Ejemplo:
Apellido Paterno - Apellido Materno - Nombre - Nota - Fecha1 - Fecha2 - Fecha3 -

MIGUEL - RUIZ - LOPEZ - XXXX- 01/01/12 - 25/05/12 - 10/09/12

Quiero obtener lo siguiente:

Apellido Paterno - Apellido Materno - Nombre - Nota - Fecha
MIGUEL - RUIZ - LOPEZ - XXXX - 01/01/12
MIGUEL - RUIZ - LOPEZ - XXXX - 25/05/12
MIGUEL - RUIZ - LOPEZ - XXXX - 10/09/12

Como veras las columnas Fecha1-Fecha2-Fecha3 ahora es llamada Fecha pero con 3 registros (las 3 fechas distintas que estaban en las columnas).

1 respuesta

Respuesta
1

Ok, vamos

He considerado el mismo modelo que has puesto en el ejemplo, por ende las fechas comienzan en la columna E

Necesitaremos 2 hojas, la hoja 1 donde estan tus datos y la hoja 2 en donde solo deben estar los titulos Apellido Paterno Apellido Materno Nombre Nota Fecha

Desde A1 hasta E1

Lego debes insertar un modulo ( no de clase) y en este modulo pegas el macro:

Sub TABLA()
Dim R As Range
Dim F As Long
Dim F2 As Long
Sheets(1).Select
F = Application.WorksheetFunction.CountA(Sheets(1).Range("a:a"))
If F <= 1 Then Exit Sub
'4c7569735f50
Application.ScreenUpdating = False
For Each R In Sheets(1).Range("a2:" & "A" & F)
Sheets(1).Select
F2 = Application.WorksheetFunction.CountA(Sheets(2).Range("e:e")) + 1
Range(R, R.Offset(0, 3)).Select
Selection.Copy
Sheets(2).Select
Sheets(2).Range("A" & F2).Select
ActiveSheet.Paste
Sheets(1).Select
R.Offset(0, 4).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(2).Select
Sheets(2).Range("e" & F2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("A" & F2 & ":" & "D" & F2).Select
Selection.Copy
Selection.AutoFill Destination:=Range("A" & F2 & ":" & "D" & Application.WorksheetFunction.CountA(Sheets(2).Range("e:e")))
DoEvents
Next
Set R = Nothing
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End Sub

Grabas y listo

Luego lo corres como cualquier macro normal
esto fue escrito para version 2007
importante es que no existan filas vacias entre los datos de la hoja1
el macro recorre cada fila de esa hoja y si hay espacios solo tomara hasta ese rango
dependiendo de que tantos datos tienes en hoja 1 es lo qeu puede tardar la ejecucion del macro
debes esperar hasta que se te informe el fin de la ejecucion mediante un mensaje en pantalla

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas