Modificar y copiar rango seleccionado
Buen día experto:
Mi inquiedtud es la siguiente;
Tengo algunos datos en la hoja 1 organizados en las columnas a,b ej:
A B
1 NOMBRE X
2 CIUDAD Y
3 FECHA Z
Y en la hoja 2 tengo los datos organizados así:
A B C D
1 nombre ciudad fecha otro
2 X 1
3 Y 2
En la hoja 2 cambian los datos a diario por lo que cambia el numero de filas con datos, un día puede ser un dato y el otro día pueden ser 500.
Lo que intento hacer es que el rango con datos de la primera hoja en este caso hoja 1 rango (a1:b3) sea copiado en una tercera hoja, la cantidad de veces que la hoja 2 tiene filas con datos; pero que ademas tome los datos de la primera fila y los coloque en el rango (a1:b3) ordenadamente nombre con nombre, fecha con la fecha etc. Y así sucesivamente. Osea que si en la hoja 2 hay 20 filas llenas en la hoja 3 deben aparecer 20 rangos copiados cada uno con los datos colocados en la hoja 2.
Les agradezco su amable atención. Ya que es de gran urgencia
Mi inquiedtud es la siguiente;
Tengo algunos datos en la hoja 1 organizados en las columnas a,b ej:
A B
1 NOMBRE X
2 CIUDAD Y
3 FECHA Z
Y en la hoja 2 tengo los datos organizados así:
A B C D
1 nombre ciudad fecha otro
2 X 1
3 Y 2
En la hoja 2 cambian los datos a diario por lo que cambia el numero de filas con datos, un día puede ser un dato y el otro día pueden ser 500.
Lo que intento hacer es que el rango con datos de la primera hoja en este caso hoja 1 rango (a1:b3) sea copiado en una tercera hoja, la cantidad de veces que la hoja 2 tiene filas con datos; pero que ademas tome los datos de la primera fila y los coloque en el rango (a1:b3) ordenadamente nombre con nombre, fecha con la fecha etc. Y así sucesivamente. Osea que si en la hoja 2 hay 20 filas llenas en la hoja 3 deben aparecer 20 rangos copiados cada uno con los datos colocados en la hoja 2.
Les agradezco su amable atención. Ya que es de gran urgencia
1 respuesta
Respuesta de calvuch
1
Inserta este código en un modulo el macro a correr se llama Transponer, este a subes llama otros dos (rótulos y datos)
Toma los datos de la hoja 2 y los pega en la hoja 3
Option Explicit
Sub transponer()
Dim n As Integer
Dim i As Integer
Hoja2.Range("A65535").Formula = "=COUNTA(R[-65534]C:R[-1]C)"
n = Hoja2.Range("A65535").Value
If n = 0 Then MsgBox "No hay datos para Copiar", vbCritical: Exit Sub
Hoja2.Range("A65535").Clear
Hoja3.Activate
Hoja3.Range("A65535").Select
Selection.End(xlUp).Select
If Selection.Address <> "$A$1" Then Hoja4.Range(Cells(Selection.Row + 1, 1), Cells(Selection.Row + 1, 1)).Select
Application.WindowState = xlMinimized
For i = 2 To n
Call rotulos(1)
Call datos(i)
DoEvents
Next
Application.WindowState = xlMaximized
MsgBox "Terminado", vbInformation, "Calvuch 2010"
End Sub
Sub rotulos(fila As Integer)
Hoja2.Select
Range("A1:D1").Select
Selection.Copy
Sheets("Hoja3").Select
Hoja3.Range("A65535").Select
Selection.End(xlUp).Select
If Selection.Address <> "$A$1" Then Hoja3.Range(Cells(Selection.Row + 1, 1), Cells(Selection.Row + 1, 1)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Selection.End(xlDown).Select
End Sub
Sub datos(df As Integer)
Hoja2.Select
Range("A" & df & ":" & "D" & df).Select
Selection.Copy
Sheets("Hoja3").Select
Hoja3.Range("B65535").Select
Selection.End(xlUp).Select
If Selection.Address <> "$B$1" Then Hoja3.Range(Cells(Selection.Row + 1, 2), Cells(Selection.Row + 1, 2)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Selection.End(xlDown).Select
End Sub
Bye
Toma los datos de la hoja 2 y los pega en la hoja 3
Option Explicit
Sub transponer()
Dim n As Integer
Dim i As Integer
Hoja2.Range("A65535").Formula = "=COUNTA(R[-65534]C:R[-1]C)"
n = Hoja2.Range("A65535").Value
If n = 0 Then MsgBox "No hay datos para Copiar", vbCritical: Exit Sub
Hoja2.Range("A65535").Clear
Hoja3.Activate
Hoja3.Range("A65535").Select
Selection.End(xlUp).Select
If Selection.Address <> "$A$1" Then Hoja4.Range(Cells(Selection.Row + 1, 1), Cells(Selection.Row + 1, 1)).Select
Application.WindowState = xlMinimized
For i = 2 To n
Call rotulos(1)
Call datos(i)
DoEvents
Next
Application.WindowState = xlMaximized
MsgBox "Terminado", vbInformation, "Calvuch 2010"
End Sub
Sub rotulos(fila As Integer)
Hoja2.Select
Range("A1:D1").Select
Selection.Copy
Sheets("Hoja3").Select
Hoja3.Range("A65535").Select
Selection.End(xlUp).Select
If Selection.Address <> "$A$1" Then Hoja3.Range(Cells(Selection.Row + 1, 1), Cells(Selection.Row + 1, 1)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Selection.End(xlDown).Select
End Sub
Sub datos(df As Integer)
Hoja2.Select
Range("A" & df & ":" & "D" & df).Select
Selection.Copy
Sheets("Hoja3").Select
Hoja3.Range("B65535").Select
Selection.End(xlUp).Select
If Selection.Address <> "$B$1" Then Hoja3.Range(Cells(Selection.Row + 1, 2), Cells(Selection.Row + 1, 2)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Selection.End(xlDown).Select
End Sub
Bye
Muchas gracias calvuch por tu gran ayuda es básicamente lo que necesitaba pero si pudieras indicarme como puedo hacer para que me quede una fila en blanco entre rangos,
ya que en la hoja 3 me queda todo unido; ademas si estuvierna en desorden las columnas osea que en la primera hoja este nombre, ciudad etc. y que se inserten los rangos como ciudad, nombre etc. Se que es mucho abusar de tu ayuda, pero es grato contar con personas como tu..
Mil Gracias
ya que en la hoja 3 me queda todo unido; ademas si estuvierna en desorden las columnas osea que en la primera hoja este nombre, ciudad etc. y que se inserten los rangos como ciudad, nombre etc. Se que es mucho abusar de tu ayuda, pero es grato contar con personas como tu..
Mil Gracias
Para insertar una linea entre datos (bloque copiado) debes modificar en ambas macros (rotulo y datos) esta linea:
If Selection.Address <> "$A$1" Then Hoja3.Range(Cells(Selection.Row + 2, 1), Cells(Selection.Row + 2, 1)).Select
Si te fijas en el código anterior inidca: Selection.Row + 1
Si modificas el 1 por otro valor como 2 o 3 o el quesea, le estarás diciendo a Excel cauntas filas debe tomar como espacio entre bloques a pegar.
Respecto al tema de las columnas, tu pregunta no fue planteada en base a esas premisas, indicaste un estructura clara y en base a eso desarrolle el código.
Si insertas columnas, ¿cómo sabría que columna tomar luego?, podrías recorrer toda la fila 1 ( rótulos) buscando identificar el rotulo para saber cual es la columna que debo tomar, pero si, ¿cambia el nombre del rotulo?, ¿Si lo borras? , si... etc, etc.
Debes tener un esquema, puedes tomar esto com plantilla y luego acomodar en otro libro las columnas como necesites.
Bye
If Selection.Address <> "$A$1" Then Hoja3.Range(Cells(Selection.Row + 2, 1), Cells(Selection.Row + 2, 1)).Select
Si te fijas en el código anterior inidca: Selection.Row + 1
Si modificas el 1 por otro valor como 2 o 3 o el quesea, le estarás diciendo a Excel cauntas filas debe tomar como espacio entre bloques a pegar.
Respecto al tema de las columnas, tu pregunta no fue planteada en base a esas premisas, indicaste un estructura clara y en base a eso desarrolle el código.
Si insertas columnas, ¿cómo sabría que columna tomar luego?, podrías recorrer toda la fila 1 ( rótulos) buscando identificar el rotulo para saber cual es la columna que debo tomar, pero si, ¿cambia el nombre del rotulo?, ¿Si lo borras? , si... etc, etc.
Debes tener un esquema, puedes tomar esto com plantilla y luego acomodar en otro libro las columnas como necesites.
Bye
