macro para transponer

[anavlis]

Hola estoy haciendo una macro en excel y tengo una duda de como realizar lo siguiente.
Lo que pasa es que tengo una base que esta en excel y tiene los siguientes campos: nombre, fecha, pregunta 1, pregunta2, pregunta 3 y pregunta4.
En los campos de nombre pregunta 1, pregunta2, pregunta 3 y pregunta4 tengo numeros tales como 2.3 , 4.5, etc lo que quiero es realizar una macro en otra hoja del excel en donde todo esto se reduzca a solo 4 campos : nombre, pregunta, nota y fecha. En el campo donde dice pregunta estarian de manera vertical todos las preguntas y en el campo donde dice nota iria el puntaje q la persona le puso. Para explicarme mejor les pongo el formato de mi base:

De esto:

Nombre Fecha Pregunta1 Pregunta2 Pregunta3 Pregunta4 Ramirez Enero 2.3 4.5 3.6 7.4
Ibarra Enero 3,7 6.5 7.8 8

a esto:

Nombre Pregunta nota fecha
Ramirez pregunta1 2.3 enero
Ramirez pregunta2 4.5 enero
Ramirez pregunta3 3.6 enero
Ramirez pregunta4 7.4 enero
Ibarra pregunta1 3.7 enero
Ibarra pregunta2 6.5 enero
Ibarra pregunta3 7.8 enero
Ibarra pregunta4 8 enero


Para esto hice una macros que en si me corre pero nunca termina de compilar, nose si lo hice bien o es que obvie algun detalle:

Dim i As Byte, j As Byte

For j = 2 To 83
For i = 2 To 100
Sheets("Hoja3").Select
Range(Cells(i, 2), Cells(i, 2)).Select
Selection.Copy
Sheets("Hoja4").Select
ActiveSheet.Paste
Range(Cells(i, 1), Cells(i, 1)).Select
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 1
Range("B2:B78").Select
Application.CutCopyMode = False
Selection.Copy
n = i + 77
Range(Cells(n, 2), Cells(n, 2)).Select
ActiveSheet.Paste
Range(Cells(n, 1), Cells(n, 1)).Select
Application.CutCopyMode = False

m = n + 77
Selection.AutoFill Destination:=Range(Cells(n, 1), Cells(m, 1))
Range(Cells(n, 1), Cells(m, 1)).Select
s = j + 5
b = i + 76
u = m - 1
Range(Cells(b, 3), Cells(b, 7)).Select
Selection.AutoFill Destination:=Range(Cells(b, 3), Cells(u, s))
Range(Cells(3, n), Cells(7, m)).Select


Range(Cells(n, 3), Cells(m, 7)).Select

l = i - 1
Z = j + 76
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Hoja3!R1C1:R3C83,R[1]C[8],0)"
Range(Cells(n, 3), Cells(n, 3)).Select
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 1

h = i + 74
g = j + 6
u = m - 1
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Hoja3!R1C1:R3C83,R[-76]C[8],0)"
Range(Cells(n, 3), Cells(u, 3)).Select
Selection.AutoFill Destination:=Range(Cells(n, 3), Cells(u, 3))
Range(Cells(n, 3), Cells(u, 3)).Select
Range(Cells(n, 3), Cells(n, 3)).Select
ActiveWindow.SmallScroll Down:=4
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 134
Range(Cells(m, 1), Cells(m, 1)).Select
Next i
Next j

Si alguien podria darme una mano con esto se los agradeceria, al parecer estoy cerca de lograrlo pero ahi me estanque y ya no se por donde mas ir.

Gracias!!!!!!!!!!!

[mrocf]

Hola! anavlis. Suponiendo que:

a) Los datos los tuvieses en la hoja "Hoja3", en el rango A1:F100 con los "títulos" en la fila 1;

b) Y que los quisieses pasar a la hoja "Hoja4", en las columnas A:D con los "títulos" en la fila 1

entonces podrías intentar con el siguiente:

Código PHP:

  Sub CambioDeFormato()
Dim qPreg As Byte, C As Range

Worksheets("Hoja4").[a1].CurrentRegion.Offset(1).Delete xlShiftUp
qPreg = Worksheets("Hoja3").[a1].End(xlToRight).Column - 2

For Each C In Range(Worksheets("Hoja3").[a2], Worksheets("Hoja3").[a1].End(xlDown))
  With Worksheets("Hoja4").[a65536].End(xlUp)
    .Offset(1, 0).Resize(qPreg) = C
    .Offset(1, 1).Resize(qPreg) = WorksheetFunction.Transpose(C.Parent.[c1].Resize(, qPreg))
    .Offset(1, 2).Resize(qPreg) = WorksheetFunction.Transpose(C.Offset(, 2).Resize(, qPreg))
    C.Offset(, 1).Copy .Offset(1, 3).Resize(qPreg)
  End With
Next C
End Sub  
   

¿Te puede servir?...
Saludos, Cacho.

[anavlis]

hola mcrof!

El codigo si me ayudó gracias!! pero me queda una duda, el campo de los nombres los coge y los pone de manera aleatoria me parece, es decir no conserva el orden de la hoja en la que tengo los datos, ¿hay alguna manera de que esto no ocurra?

Gracias!

[mrocf]

El bloque de instrucciones:

For Each C In Range(Worksheets("Hoja3").[a2], Worksheets("Hoja3").[a1].End(xlDown))

Next C

hace -exactamente- lo que necesitas: mantener el orden original de los nombres.
Saludos, Cacho.

[mrocf]

Si quieres, puedes subir tu implementación a un servidor gratuito (MediaFire, MegaUpload, etc) para ver que es lo que no te está funcionando adecuadamente.

Saludos, Cacho.

[anavlis]

En si no cambie mucho el codigo que me sugeriste, lo que no toe es que tomo como primer dato el ultimo de mi base y luego el segundo y de ahi sigue correlativamente. Ahora pongo el codigo en un servidor para que lo veas.

Gracias!

[anavlis]

Hola aqui te dejo el link del codigo que he estado usando, ah una pregunta he querido volver a correr el codigo en la macro y me dice error en el rango en esta fila:
For Each C In Range(Worksheets("Hoja3").[a2], Worksheets("Hoja3").[a1].End(xlDown)

al igual que en esta linea:
.Offset(1, 0).Resize(qPreg) = C
´me dice que hay un error pero cuando lo probé la primera vez me corrió normal sin problemas pero ahora me bota ese error.


Aqui te dejo el link: http://www.mediafire.com/?6on2d1lr4inh92e
Gracias!!

[anavlis]

Hola aqui te dejo el link del codigo que he estado usando, ah una pregunta he querido volver a correr el codigo en la macro y me dice error en el rango en esta fila:
For Each C In Range(Worksheets("Hoja3").[a2], Worksheets("Hoja3").[a1].End(xlDown)

al igual que en esta linea:
.Offset(1, 0).Resize(qPreg) = C
´me dice que hay un error pero cuando lo probé la primera vez me corrió normal sin problemas pero ahora me bota ese error.

Gracias!!

[mrocf]

No tienes que subir al servidor gratuito el código... De hecho: lo pudiste haber publicado aquí del mismo modo que lo hiciste con tu primer envío...

Lo que tienes que subir es tu libro con la implementación del código, pues deseo ver lo mismo que tú: ¿se entiende?

Es suficiente que incluya el apellido de dos o tres estudiantes y sus respectivas notas.

Saludos, Cacho.

[anavlis]

Ok aqui te paso el link con el archivo: http://www.mediafire.com/?6a9b39dc3yx47bt

Gracias!

[mrocf]

De este último archivo que has subido ahora puede decirse:

a) Que no tiene implementada la macro: ¿Es un chiste, verdad?

b) Que la estructura de los datos iniciales no se corresponde con lo que publicaras al inicio de este tema.

Debo decirte -con toda franqueza- que esto ha sido una verdadera pérdida de tiempo.
Saludos, Cacho.