UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

David Pineda


Buenos días:
He estado intentando hacer un macro para poder Importar datos de varios TXT a una sola hoja Excel revisando temas del foro.


He llegado hasta dos códigos que "casi" hacen lo que necesito, el problemas es que no se como "unirlos"
os voy pegando los códigos a ver si alguien me puede ayudar (soy totalmente inexperto).

Este lo he encontrado tal cual:



Código:
Sub abrir_txt()
On Error Resume Next
milibro = ActiveWorkbook.Name
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONA CARPETA", 0, "C:\").items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.txt")
Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited
otro = ActiveWorkbook.Name
ActiveSheet.Copy before:=Workbooks(milibro).Sheets(1)
Workbooks(otro).Close False
archi = Dir()
Loop
End Sub


Importa todos los archivos de una carpeta en diferentes hojas del mismo libro.



Código:
Sub Impor_PPVT_xls_1()
' Importa los datos de un archivo TXT generado por el PPVT a XLS
Dim RutaArchivo As String
Dim cel As String

'controlamos alg˙n posible error.
On Error Resume Next
'damos valor a la variable Filename
'adem·s hemos cambiado el TÌtulo que aparecer· en la ventana di·logo
'y forzamos para que sÛlo abra ficheros de Excel (extensiÛn .xlsx)
RutaArchivo = Application.GetOpenFilename(Title:="Prueba selecciÛn ficheros Excelforo", _
                            filefilter:="TXT files (*.txt), *.txt")
'si hemos seleccionado alg˙n archivo muestra un cuadro mensaje
If Not RutaArchivo = "Has cancelado la selecciÛn de archivo" Then
    MsgBox RutaArchivo
End If
  With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & RutaArchivo, Destination:=Range("A1"))
        .Name = "FileName"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlMacintosh
        .TextFileStartRow = 12
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 1, 1, 9, 1, 9, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = " "
        .Refresh BackgroundQuery:=True
    End With
    Range("A1").Select
cel = ActiveCell.Address
Range(ActiveCell, ActiveCell.Offset(0, 3)).Copy
Range("A16").Select
ActiveCell.PasteSpecial
Range(cel).Offset(1, 0).Select
For x = 1 To 8
cel = ActiveCell.Address
Range(ActiveCell, ActiveCell.Offset(0, 3)).Copy
Range("A16").Select
ActiveCell.End(xlToRight).Offset(0, 1).Select
ActiveCell.PasteSpecial
Range(cel).Offset(1, 0).Select
Next x
' trasponer Macro
    Range("A11:A14").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=28
    Range("AK16").Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
     
        Rows("1:15").Select
    Range("A15").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp

End Sub


Este otro me importa un solo archivo pero con el formato que necesito y me ordena los datos en una sola fila.

Lo que necesito es que importe todos los archivos de una carpeta como lo hace el segundo código y si es posible que en vez de hacerlo en hojas diferentes, me los vaya pegando por filas, incluyendo una que indique el nombre del archivo de que proceden los datos.

Muchas gracias y espero no haberme saltado muchas normas del foro.

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.