Jump to content
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

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.

Sign in to follow this  



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png