Create new sheets and then import three txt files into their own columns-CodePudding

So backstory, I am currently copying and pasting three .txt files into their own columns per sheet. However, I have a mass amount of data so copying and pasting three .txt files into their own columns per sheet is time consuming. When I right clicked on the sheet to delete it, I saw the button "View code". In astonishment, I see an opportunity to automate this process to save tons of time. I see a vision of

specifying pathnames to the .txt files I am copying and pasting
specifying which column to paste the entire content of the .txt file

With that said, here is an example of what I would like to accomplish using the VBA system in Excel

Starting off, here are 9 .txt files that would be imported into the Worksheet:

TxtFile1Sheet1.txt
Cow1
Rabbit1
Deer1
Crab1
Goat1
Ducks1

TxtFile2Sheet1.txt
Vegetables1
Eggs1
Meat1
Poultry1
Fish1
Seeds1

TxtFile3Sheet1.txt
Fiction1
Narrative1
Novel1
Thriller1
Mystery1
Poetry1

TxtFile1Sheet2.txt
Cow2
Rabbit2
Deer2
Crab2
Goat2
Ducks2

TxtFile2Sheet2.txt
Vegetables2
Eggs2
Meat2
Poultry2
Fish2
Seeds2

TxtFile3Sheet2.txt
Fiction2
Narrative2
Novel2
Thriller2
Mystery2
Poetry2

TxtFile1Sheet3.txt
Cow3
Rabbit3
Deer3
Crab3
Goat3
Ducks3

TxtFile2Sheet3.txt
Vegetables3
Eggs3
Meat3
Poultry3
Fish3
Seeds3

TxtFile3Sheet3.txt
Fiction3
Narrative3
Novel3
Thriller3
Mystery3
Poetry3

Here is the VBA workspace that I want to use to import these txt files to their own columns.

Sub ImportThreeTxtFiles()
'
' ImportThreeTxtFiles Macro
' Import three txt files into three columns per sheet
'

'
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;/Users/MyName/Documents/TxtFile1Sheet1", _
        Destination:=Range("$A$2"))
        .Name = "TxtFile1Sheet1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 10000
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("B2").Select
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;/Users/MyName/Documents/TxtFile2Sheet1", _
        Destination:=Range("$B$2"))
        .Name = "TxtFile2Sheet1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 10000
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("C2").Select
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;/Users/MyName/Documents/TxtFile3Sheet1", _
        Destination:=Range("$C$2"))
        .Name = "TxtFile3Sheet1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 10000
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Using this Macro I recorded, I want to import these files into their own sheets. How could I specify the three sets of files I will paste in a form of a loop? As in:

FileSet1 = TxtFile1Sheet1.txt, TxtFile2Sheet1.txt, TxtFile3Sheet1.txt


FileSet2 = TxtFile1Sheet2.txt, TxtFile2Sheet2.txt, TxtFile3Sheet2.txt


FileSet3 = TxtFile1Sheet3.txt, TxtFile2Sheet3.txt, TxtFile3Sheet3.txt

These columns will be named Animals, Type of Foods, Genres

Here is the desired output:

I am very new to VBA, I have more of a background in Python. This example is meant to be more conceptual. How would I be able to loop or call these files into these three columns? I'd love to see how the community tackles this to learn from it. I am currently watching videos and reading more about it. Thanks!

CodePudding user response：

Please, test the next code and send some feedback. Take care of using the real folder path where the text file exist:

Sub ImportTextFilesInColumns()
  Dim wb As Workbook, sh As Worksheet, strFoldPath As String
  Dim fileName As String, shName As String, colNo As Long, arrHd, arrTxt
  
  Set wb = ActiveWorkbook ' you can set here the workbook you need
  
  arrHd = Split("Animals, Type of Foods, Genres", ", ") 'put the headers string in an array
  strFoldPath = "Your real folder path" 'place here the folder path where the text file exist
  'some optimization: _________________________________________________
  Application.ScreenUpdating = False: Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  '____________________________________________________________________
  'Place the header on the necessary sheets:
  For Each sh In wb.Sheets
        Select Case sh.Name
            Case "Sheet1", "Sheet2", "Sheet3"
              sh.Range("A1:C1").value = arrHd
        End Select
  Next
  'iterate between all text files in strFolder:
  fileName = dir(strFoldPath & "\*.txt")
  Do While fileName <> ""
        colNo = CLng(Mid(fileName, 8, 1))  'extract column number
        shName = Mid(fileName, 9, 6)       'extract sheet name
        'place the content of the text file in an array:
        arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(strFoldPath & "\" & fileName, 1).ReadAll, vbCrLf)
        wb.Sheets(shName).cells(2, colNo).Resize(UBound(arrTxt)   1, 1) = Application.Transpose(arrTxt) ' drop the array content

        fileName = dir()                    'continue the iteration between files
  Loop
  Application.ScreenUpdating = True: Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox "Ready..."
End Sub

No error handling in case of no sheet with the name extracted from the last 6 digits of the text file (before .txt). You must be atentive when build the txt files name. Such an error handling can be imagined, but not treated in the above code...