Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

Sign in to follow this  
ssanceb

Resumir una macro con otra más sencilla

Recommended Posts

Hola a todos, me gustaría saber si conocéis alguna forma de resumir esta macro que he hecho, que lo que hace en definitiva es copiar un rango y transponerlo en la hoja2, con la peculiaridad de que va avanzando de columna cada 6 filas que ha copiado en la hoja 1.

Si os fijáis los únicos parámetros que varían en cada uno de los días que he hecho serían la columna y el número que le resto a la variable h para que me de siempre la fila 3, 10, 17, 24, 31, y 38.

Por otro lado al hacer lo mismo con los días de la semana me da problemas, ¿puede ser porque copio celdas combinadas y al pegarlo son celdas normales?.

Bueno os dejo la macro para que veáis como se ejecuta y si podéis echarme una mano, simplemente porque aunque se ejecuta bien, estoy seguro de que puede hacerse de una forma más fácil y estoy tan encerrado que tal vez la tenga delante y ni me doy cuenta.

Os dejo aquí la macro y subo también archivo por si os puede ayudar en algo.

Muchas gracias de antemano a todos los que hacéis posible que compartamos conocimientos día a día por aquí.

Un saludo.

Sub Transponer()

'************************Evitar parpadeo

Application.ScreenUpdating = False

'************Transponer de Hoja1 a Hoja2

'LUNES

For x = 1 To 6

For j = 3 To 8

Sheets("Hoja1").Select

Range(Cells(x, 3), Cells(x, 8)).Copy

Sheets("Hoja2").Select

h = (x - 1) * 7 + 3

Range("B" & h).PasteSpecial Transpose:=True

Next

Next

'MARTES

For x = 7 To 12

For j = 3 To 8

Sheets("Hoja1").Select

Range(Cells(x, 3), Cells(x, 8)).Copy

Sheets("Hoja2").Select

h = (x - 1) * 7 + 3 - 42

Range("C" & h).PasteSpecial Transpose:=True

Next

Next

'MIÉRCOLES

For x = 13 To 18

For j = 3 To 8

Sheets("Hoja1").Select

Range(Cells(x, 3), Cells(x, 8)).Copy

Sheets("Hoja2").Select

h = (x - 1) * 7 + 3 - 84

Range("D" & h).PasteSpecial Transpose:=True

Next

Next

'JUEVES

For x = 19 To 24

For j = 3 To 8

Sheets("Hoja1").Select

Range(Cells(x, 3), Cells(x, 8)).Copy

Sheets("Hoja2").Select

h = (x - 1) * 7 + 3 - 126

Range("E" & h).PasteSpecial Transpose:=True

Next

Next

'VIERNES

For x = 25 To 30

For j = 3 To 8

Sheets("Hoja1").Select

Range(Cells(x, 3), Cells(x, 8)).Copy

Sheets("Hoja2").Select

h = (x - 1) * 7 + 3 - 168

Range("F" & h).PasteSpecial Transpose:=True

Next

Next

End Sub

Transponer final web.rar

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png