• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy and paste multiple text excel files on the same file with hyperlink and table titles

Good morning.

I have more txt files. It is possible to create a macro that opens many pages excel (in the same file) how many text files are in the "text" folder on the desktop and paste the contents of each text file on each excel page.

The macro should not only import the data on every excel page, but it must also include the title of the columns, which I will put in the "list" page. If I modify the name of the columns on the page list or insert new columns one day, the table columns of all the pages in the excel file will automatically be updated.

Once done this I would like to have hyperlinks that return to the page with the same name.

I attach an example

ps. I do not have the right knowledge to create macros.
 

Attachments

  • Cartel1.xlsx
    13.5 KB · Views: 12
Hi,
See attached (unzip it first)
I think I covered the things you asked for.
Edit: no need to open the textfiles
 

Attachments

  • Txt files.zip
    18.8 KB · Views: 9
good morning.

I tried the macro however I noticed that the data is not fully aligned. There is no problem with the size of the file.

I have tried to manually open the text file, then I clicked on "edit all" and then on "copy" from the edit menu. After I glued it to the excel cell a1 and it all goes well.

Why is this not the case with the macro?

thank you
 
Is there anyone who can improve this macro? Unfortunately the result of importing from the excel text file is not the same as copying and pasting from excel text files.
 
Hi, stefanoste78!
Consider uploading a sample text file. It'd be easier to understand for people who might be able to help you.
Include a manually written output of the requested solution. Thanks.
Regards!
 
Hi, stefanoste78!
Consider uploading a sample text file. It'd be easier to understand for people who might be able to help you.
Include a manually written output of the requested solution. Thanks.
Regards!


Good morning.

You are right…

This is the text file:

https://www.dropbox.com/s/ax5efm20pzbi354/IT.txt?dl=0

Instead this is the excel file I got by opening the text file, then selecting all the content (by editing) and pasting everything on excel, starting from cell "A2".

The contents of the cells of the times are aligned to the left to the right. Is it also possible to get the alignment to the left?

https://www.dropbox.com/s/bo4bskmk5vg8kkt/IT.xlsx?dl=0

Thank you
 
Hi, stefanoste78!

Give a try at the attached file, this is the VBA code:

Code:
Option Explicit

Sub ImportTextFileTabSeparatedNewSheets()
    ' constants
    ' declarations
    Dim sPath As String, sFile As String, sName As String
    Dim I As Integer, A As String
    ' start
    sPath = ThisWorkbook.Path
    sFile = Dir(sPath & "\*.txt")
    With ThisWorkbook
        Worksheets(.Worksheets.Count).Activate
    End With
    ' process
    Do Until sFile = ""
        ' worksheet
        ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
        On Error Resume Next
        sName = Left(sFile, InStr(sFile, ".") - 1)
        ActiveSheet.Name = sName
        On Error GoTo 0
        ' text file
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & "\" & sFile, Destination:=Range("$A$2"))
            .Name = sName
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        ' titles
        I = 1
        With ActiveSheet
            Do While Worksheets(1).Cells(2, I + 4).Value <> ""
                .Cells(1, I).Value = Worksheets(1).Cells(2, I + 4).Value
                I = I + 1
            Loop
        End With
        ' link
        With Worksheets(1)
            .Activate
            I = .Cells(1, 1).End(xlDown).End(xlDown).End(xlUp).Row + 1
            .Cells(I, 1).Value = sName
            .Cells(I, 2).Select
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
        End With
        ' cycle
        sFile = Dir()
    Loop
    ' end
    ThisWorkbook.Worksheets(1).Activate
    Range("A1").Select
    Beep
End Sub

Regards!

PS: BTW, it's in Spanish?
 

Attachments

  • Cartel1.xlsm
    28.1 KB · Views: 6
Hello.
The file covers the countries in italy.
I tried your macro. The data is pasted in order. Unfortunately, however, there are two problems to be solved:

1) The text files will be a 250 and the macro at a certain point will hang up by giving an error message;
2) There are some character recognition issues.

I attach the files relating to the two problems
 

Attachments

  • 1.JPG
    1.JPG
    16.3 KB · Views: 6
  • 2.xlsx
    8.9 KB · Views: 1
Hi stefanoste78!

I thought it was in Italian, it's just that the word "elenco" made me doubt. It's Spanish and I thought that in Italian it was "lanciare" o "cast" only.

Regarding 1) let me check it for performance enhancements.
Regarding 2) please upload the related text file in .txt format.

Regards!
 
Hi stefanoste78!

I thought it was in Italian, it's just that the word "elenco" made me doubt. It's Spanish and I thought that in Italian it was "lanciare" o "cast" only.

Regarding 1) let me check it for performance enhancements.
Regarding 2) please upload the related text file in .txt format.

Regards!

They are all txt files. Fixed you have to set the character encoding type that changes for some of the alphabets.

Can also align the cell contents to the left?

Thank you
 
Hi, stefanoste78!

Regarding 1): copy this code after With...EndWith of "' text file" segment:
Code:
        With ActiveSheet.QueryTables
            .Item(.Count).Delete
        End With

Regarding 2): copy this code after "' title" segment:
Code:
    ActiveSheet.Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Regards!
 
Hi, stefanoste78!

Regarding 1): copy this code after With...EndWith of "' text file" segment:
Code:
        With ActiveSheet.QueryTables
            .Item(.Count).Delete
        End With

Regarding 2): copy this code after "' title" segment:
Code:
    ActiveSheet.Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Regards!

Hi
I will put the excel file with your changes.
Basically, the opening phase of text files has improved. Up to 160 250-file files arrive, but then it crashes and exits the out-of-memory 7 runtime error mask.
Cell content aligns to the left, however, does not recognize special characters. You can try the file I have attached to you. It would be a general characterization procedure. Is this the last thing feasible?
See you soon
 

Attachments

  • AE.txt
    894 KB · Views: 6
  • Copia di Cartel1-3.xlsm
    20.2 KB · Views: 7
Hi, stefanoste78!
It's due to different types (origin or source) of .txt files. Text files have an attribute called origin or source which indicates which alphabet (set of characters) has to be used to properly open it. The first file had 1252 (Windows ANSI) and the last 65001 (Unicode UTF-8). And I don't know any way of retrieving it to be used as you require here, so if you have files that you want to process in the same pass I'm afraid you're in trouble.
Regards!
 
Hi, stefanoste78!
It's due to different types (origin or source) of .txt files. Text files have an attribute called origin or source which indicates which alphabet (set of characters) has to be used to properly open it. The first file had 1252 (Windows ANSI) and the last 65001 (Unicode UTF-8). And I don't know any way of retrieving it to be used as you require here, so if you have files that you want to process in the same pass I'm afraid you're in trouble.
Regards!

good morning
The solution to the problem ... transform the cell contents into text to exclude anything from excel and 65001 UTF8 encoding.
The problem remains that on 247 files only opens 163, it will be tied to the ram.
Should I divide the folder into three but then could I join them by getting the result I set for?
See you soon



Option Explicit

Sub ImportTextFileTabSeparatedNewSheets()
' constants
' declarations
Dim sPath As String, sFile As String, sName As String
Dim I As Integer, A As String
' start
sPath = ThisWorkbook.Path
sFile = Dir(sPath & "\*.txt")
With ThisWorkbook
Worksheets(.Worksheets.Count).Activate
End With
' process
Do Until sFile = ""
' worksheet
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
On Error Resume Next
sName = Left(sFile, InStr(sFile, ".") - 1)
ActiveSheet.Name = sName
On Error GoTo 0
' text file
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & "\" & sFile, Destination:=Range("$A$2"))
.Name = sName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables
.Item(.Count).Delete
End With
' titles
I = 1
With ActiveSheet
Do While Worksheets(1).Cells(2, I + 4) <> ""
.Cells(1, I) = Worksheets(1).Cells(2, I + 4)
I = I + 1
Loop
End With
ActiveSheet.Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' link
With Worksheets(1)
.Activate
I = .Cells(1, 1).End(xlDown).End(xlDown).End(xlUp).Row + 1
.Cells(I, 1).Value = sName
.Cells(I, 2).Select
.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
End With
' cycle
sFile = Dir()
Loop
' end
ThisWorkbook.Worksheets(1).Activate
Range("A1").Select
Beep
End Sub
 
Hi, stefanoste78!

When posting code, please embed it into code tags, 5th icon from the right in the light blue bar just above the text box where you write.

I didn't test if but if the results seem to suit your requirements then go ahead. Just a comment: 1252 and 65001 are not the only text sources, there are a lot of them. From Excel, Data tab, From Text icon, select a text file, and check the source drop down combo box.

Regarding procedures that replace diacritic characters with "normal" characters, like https://www.mrexcel.com/forum/excel-questions/1008104-replacing-special-characters-geo.html, you're loosing information, i.e., it's not the same "años" than "anos" (check a Spanish dictionary). I do not recommend so, I'd rather group the text files by its source and then process each group using the proper code.

Regards!
 
Hi, stefanoste78!

When posting code, please embed it into code tags, 5th icon from the right in the light blue bar just above the text box where you write.

I didn't test if but if the results seem to suit your requirements then go ahead. Just a comment: 1252 and 65001 are not the only text sources, there are a lot of them. From Excel, Data tab, From Text icon, select a text file, and check the source drop down combo box.

Regarding procedures that replace diacritic characters with "normal" characters, like https://www.mrexcel.com/forum/excel-questions/1008104-replacing-special-characters-geo.html, you're loosing information, i.e., it's not the same "años" than "anos" (check a Spanish dictionary). I do not recommend so, I'd rather group the text files by its source and then process each group using the proper code.

Regards!

Formatting the cell as a text not by character encoding problems. If so, any character is excel as it is on the text file. Right?
 
Hi, stefanoste!
There's no such a thing as Excel characters. Characters in text files have 1-byte values or 2-byte values for Unicode for examples. Excel reads the text file according the source type that the file specifies or that you set up by code.
Regards!
 
Hi, stefanoste!
There's no such a thing as Excel characters. Characters in text files have 1-byte values or 2-byte values for Unicode for examples. Excel reads the text file according the source type that the file specifies or that you set up by code.
Regards!

Is there no solution if you do not copy and paste manually? As you wrote, you should look for the type of encoding each time. It seems hard to do ..
 
Back
Top