Macro para Importar txt y renombrar hojas

Necesito hacer una importación de de varios archivos .txt que están en una carpeta especifica, ejemplo peras.txt, manzanas.txt, naranjas.txt

La idea seria poder cargar todos los datos de forma independiente, es decir que pueda cargar los datos del archivo peras.txt y lo guarde en una hoja con el mismo nombre (peras) y que al importar manzanas.txt me lo guarde en otra hoja con el nombre manzanas.

Actualmente ya tengo una macro que simplemente me da a elegir que archivo quiero importar y luego de la elección me lo carga formateado y listo para usar.

Pero necesito que cada hoja tenga como nombre la descripción de los archivos ya que mi idea es importar varios a la vez.

Alguien seria tan amable de asesorarme o ayudarme ... Ya creo que me quede trancado :(

Desde ya muchas gracias ! Genios

2 Respuestas

Respuesta
3

[Ho la y bienvenido a TodoExpertos!

Puedes poner aquí tu macro para saber cómo estás leyendo el archivo, qué formato tiene el archivo y en cuál celda inicial de la hoja se van a empezar a poner los datos.


Te puede interesar:

Consejos para desarrollar macros - YouTube

Recomendación: En el futuro, sería magnífico, si pudieras pegar el código utilizando el icono para Insertar código fuente:

Después de presionar el icono, aparece una ventana donde puedes pegar el código:

Presiona "Ok" para insertar el código.

De esta manera es fácil de leer el código.

Prueba la siguiente macro.

Te pide que selecciones la carpeta donde tienes los archivos txt.

Selecciona la carpeta y presiona Aceptar.

La macro leerá los archivos txt y creará una hoja con la información de cada txt.

Sub importar_archivos()
'Por Dante Amor
  Dim sPath As String, nombreArchivo As String, hoja As String
  Dim sArch As Variant
  Dim sh As Worksheet
  '
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Selecciona la carpeta donde tienes los txt"
      If .Show <> -1 Then Exit Sub
      sPath = .SelectedItems(1)
    End With
  End With
  sArch = Dir(sPath & "\" & "*.txt")
  '
  Do While sArch <> ""
    nombreArchivo = sPath & "\" & sArch
    hoja = Left(sArch, Len(sArch) - 4)
    On Error Resume Next: Sheets(hoja).Delete: On Error GoTo 0
    '
    Sheets.Add after:=Sheets(Sheets.Count)
    Set sh = ActiveSheet
    sh.Name = hoja
    With sh.QueryTables.Add(Connection:="TEXT;" & _
      nombreArchivo, Destination:=sh.Range("$B$5"))
      .Name = "recibe_onda_" & hoja
      .FieldNames = True:                   .RowNumbers = False
      .FillAdjacentFormulas = False:        .PreserveFormatting = True
      .RefreshOnFileOpen = False:           .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False:                .SaveData = True
      .AdjustColumnWidth = True:            .RefreshPeriod = 0
      .TextFilePromptOnRefresh = False:     .TextFilePlatform = 850
      .TextFileStartRow = 1:                .TextFileParseType = xlFixedWidth
      .TextFileTextQualifier = 1:           .TextFileConsecutiveDelimiter = False
      .TextFileTabDelimiter = True:         .TextFileSemicolonDelimiter = False
      .TextFileCommaDelimiter = False:      .TextFileSpaceDelimiter = False
      .TextFileColumnDataTypes = Array(1, 1, 1, 1)
      .TextFileFixedColumnWidths = Array(14, 35, 20)
      .TextFileTrailingMinusNumbers = True: .Refresh BackgroundQuery:=False
    End With
    sArch = Dir()
  Loop
  '
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Comparte los enlaces con alguien que desee conocer sobre Excel y Macros.


Sal u dos

¡Gracias!  Dante 

Era lo que realmente andaba buscando !!!

Abusando de tu amabilidad ... puedo agregar formatear la información de los txt ... a modo de ejemplo, dar formatos de tabla para luego poder consolidar estos datos en otra pestaña?

O necesito crear otra macro ?

Utiliza lo siguiente para poner el rango de datos de cada hoja en una tabla. Ya desde ahí puedes utilizar las tablas para consolidarlas.

Sub importar_archivos()
'Por Dante Amor
  Dim sPath As String, nombreArchivo As String, hoja As String, rango As String
  Dim sArch As Variant
  Dim sh As Worksheet
  '
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Selecciona la carpeta donde tienes los txt"
      If .Show <> -1 Then Exit Sub
      sPath = .SelectedItems(1)
    End With
  End With
  sArch = Dir(sPath & "\" & "*.txt")
  '
  Do While sArch <> ""
    nombreArchivo = sPath & "\" & sArch
    hoja = Left(sArch, Len(sArch) - 4)
    On Error Resume Next: Sheets(hoja).Delete: On Error GoTo 0
    '
    Sheets.Add after:=Sheets(Sheets.Count)
    Set sh = ActiveSheet
    sh.Name = hoja
    With sh.QueryTables.Add(Connection:="TEXT;" & _
      nombreArchivo, Destination:=sh.Range("$B$5"))
      .Name = "recibe_onda"
      .FieldNames = True:                   .RowNumbers = False
      .FillAdjacentFormulas = False:        .PreserveFormatting = True
      .RefreshOnFileOpen = False:           .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False:                .SaveData = True
      .AdjustColumnWidth = True:            .RefreshPeriod = 0
      .TextFilePromptOnRefresh = False:     .TextFilePlatform = 850
      .TextFileStartRow = 1:                .TextFileParseType = xlFixedWidth
      .TextFileTextQualifier = 1:           .TextFileConsecutiveDelimiter = False
      .TextFileTabDelimiter = True:         .TextFileSemicolonDelimiter = False
      .TextFileCommaDelimiter = False:      .TextFileSpaceDelimiter = False
      .TextFileColumnDataTypes = Array(1, 1, 1, 1)
      .TextFileFixedColumnWidths = Array(14, 35, 20)
      .TextFileTrailingMinusNumbers = True: .Refresh BackgroundQuery:=False
    End With
    '
    'crear tabla
    rango = sh.Range("recibe_onda").Address
    sh.QueryTables("recibe_onda").Delete
    sh.ListObjects.Add(xlSrcRange, Range(rango), , xlYes).Name = "Tabla1"
    '
    sArch = Dir()
  Loop
  '
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Visita:

Sal u dos Dante Amor

¡Gracias! Dante !

Muchas gracias por tu ayuda y me disculpo por no pegar el código adecuademente.

Probare el código y si me surge alguna te molestare nuevamente :)

Por otro lado ya quede suscrpto a tu canal ... que por cierto esta muy bueno y lo recomiendo

Saludos,

Quizá no este entendiendo ... pero veo el mismo código solo que comentado !!!

Agregué estas líneas para crear las tablas:

 'crear tabla
    rango = sh.Range("recibe_onda").Address
    sh.QueryTables("recibe_onda").Delete
    sh.ListObjects.Add(xlSrcRange, Range(rango), , xlYes).Name = "Tabla1"
Respuesta
1

Paso lo que tengo que no es mucho.

Sub Importar()
'
' Importar Macro
' Importar datos
'
' Acceso directo: Ctrl+Mayús+I
'
Dim nombreArchivo As String
Static contador As Integer
contador = contador + 1
nombreArchivo = Application.GetOpenFilename()
Worksheets.Add.Name = "Datos" & contador
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & nombreArchivo, Destination:=Range( _
"$B$5"))
.Name = "recibe_onda"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(14, 35, 20)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas