Convert de 5 column y 888 filas a uno de 1 column

5 columnas y 888 filas a uno de 1 columna y 4411 filas
Tengo un archivo más o menos de la siguiente manera
8,61E-04;9,54E-04;5,41E-04;-3,71E-05;1,08E-04
1,36E-04;1,51E-04;1,33E-04;7,92E-05;1,80E-05
-6,33E-06;2,59E-05;8,84E-05;1,32E-04;1,24E-04
7,36E-05;1,92E-05;-8,66E-06;-6,53E-06;2,23E-05
nesecito convertirlo en uno de la siguiente manera
8,61E-04
9,54E-04
5,41E-04
-3,71E-05
1,08E-04
1,36E-04
1,51E-04
1,33E-04
7,92E-05
1,80E-05 
-6,33E-06
y asi sucesivamente gracias

1 Respuesta

Respuesta
1
Confírmame si los datos los tienes así
   A B C D E
8,61E-04 9,54E-04 5,41E-04 -3,71E-05 1,08E-04
si es asi dime en que columna los quieres poner ó si lo quieres en otra hoja
y te creare un codigo que te realice lo que pides
Exactamente así y los quiero en la columna G por favor
De nuevo veamos te cree un código pero necesito pasar los datos ha otra hoja porque si incremento en esas hoja los sigue copiando
Te explico 1º dime el nombre de la hoja que quieres separar los datos
2º dime una hoja vacía si no la tienes la creas y por ejemplo le pones de nombre pruebas
Con eso te pasare un código que copiara todo en la hoja pruebas después lo borrara de esa hoja y te lo pondrá en la columna G de tu hoja principal
No es necesario que me pases nada simplemente pega este código en un modulo y si la hoja que se ejecuta no es la hoja1 cambias los nombres que hay como hoja1 por el de tu hoja
'macro creada por d2enri 09-03-2011
Sub pasa_datos()
Application.CutCopyMode = True
Sheets("hoja1").Select
Range("A1").Select
If ActiveCell.Value <> "" Then
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy
Dim Tot As Integer
Application.ScreenUpdating = False
Sheets(Sheets.Count).Select
Tot = Sheets.Count
        Sheets.Add.Name = "prueba"
Sheets("prueba").Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Sheets("hoja1").Select
ActiveCell.Offset(1, 0).Select
celd = ActiveCell.Address
Else
ActiveCell.Offset(1, 0).Select
celd = ActiveCell.Address
End If
Do While ActiveCell <> ""
Range(celd).Select
If ActiveCell.Value <> "" Then
Range(ActiveCell, ActiveCell.Offset(0, 4)).Copy
Sheets("prueba").Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Sheets("hoja1").Select
celd = ActiveCell.Address
End If
ActiveCell.Offset(1, 0).Select
celd = ActiveCell.Address
Loop
Sheets("prueba").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Hoja1").Select
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
Application.DisplayAlerts = False
Sheets("prueba").Select
    ActiveWindow.SelectedSheets.Delete
Sheets("Hoja1").Select
    Range("G1").Select
End Sub
Pruébalas y si tienes alguna duda dímelo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas