Ayuda macro excel
Buen Día
Amigo no si me puedas ayudar, tengo una hoja con tres valores de la siguiente forma
A B C
1 ABCD EDFG HIJKL
2 1234 5678 1233
3 ZXCVB BNMV ZXCCV
La hoja tien más o menos 1800 registros, necesito una macro en la cula se interponga cada valor en una sola columna quedando de la siguiente forma (pero debe ser automático, solo son tres valores)
Columna A1
ABCD
EDFG
HIJKL
1234
5678
1233
ZXCVB
BNMV
ZXCCV
Agradezco tu colaboración y muchas gracias
Amigo no si me puedas ayudar, tengo una hoja con tres valores de la siguiente forma
A B C
1 ABCD EDFG HIJKL
2 1234 5678 1233
3 ZXCVB BNMV ZXCCV
La hoja tien más o menos 1800 registros, necesito una macro en la cula se interponga cada valor en una sola columna quedando de la siguiente forma (pero debe ser automático, solo son tres valores)
Columna A1
ABCD
EDFG
HIJKL
1234
5678
1233
ZXCVB
BNMV
ZXCCV
Agradezco tu colaboración y muchas gracias
Respuesta de Eduard Caballero
1
Acá tienes
Prueba la macro aparte primero para ver el funcionamiento. A mi me funciona
Pero ojo, con gran cantidad de datos puede tardarse la pc
Sub prueba()
Application.ScreenUpdating = False
i = 2
Range("a2").Select
For i = 2 To 65000
If ActiveCell = "" Then
Exit For
Else
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveCell.Offset(-1, 0).Select
Selection.EntireRow.Delete
ActiveCell.Offset(3, 0).Select
Prueba la macro aparte primero para ver el funcionamiento. A mi me funciona
Pero ojo, con gran cantidad de datos puede tardarse la pc
Sub prueba()
Application.ScreenUpdating = False
i = 2
Range("a2").Select
For i = 2 To 65000
If ActiveCell = "" Then
Exit For
Else
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert
ActiveCell.Offset(-1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveCell.Offset(-1, 0).Select
Selection.EntireRow.Delete
ActiveCell.Offset(3, 0).Select
Buenas Tardes
Una vez más me salvaste, agradezco infinitamente tu colaboración y me parece genial que personas como tu tengan la capacidad de compartir sus conocimientos con la sociedad, eres un magaso
Gracias
Una vez más me salvaste, agradezco infinitamente tu colaboración y me parece genial que personas como tu tengan la capacidad de compartir sus conocimientos con la sociedad, eres un magaso
Gracias
