• 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.

Import Multiple Text with pre-defined header in worksheet

Below script works perfect for importing multiple text files without duplicate header. But, requirement is paste the data in second row of worksheet. In first row, there is Import button for calling macro. But, as soon as execution completes first row is vanished and data is pasted.

PS: iAuto is macro-enabled workbook, File-1,File-2,File-3 are text file for importing

Please change path for importing text file as: sFolder = "G:\Team Learning\vbapractice\Dunning\Import\"

>>> use code - tags <<<

Code:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim sFolder As String, vDB, Ws As Worksheet
Dim rngT As Range
' Get a FileSystem object
Set fso = New FileSystemObject

    ' get the directory you want

    sFolder = "G:\Team Learning\vbapractice\Dunning\Import\"
    Set folder = fso.GetFolder(sFolder)
    ' set the starting point to write the data to
    'Worksheets("Sheet1").Activate
    'Set Ws = ActiveSheet
    Set Ws = Sheets("Data")
    'Set cl = ActiveSheet.Cells(1, 1)
    Ws.Cells.Clear
    ' Loop thru all files in the folder
    For Each file In folder.Files
        i = i + 1
        Workbooks.Open Filename:=sFolder & file.Name, Format:=1
        With ActiveWorkbook.ActiveSheet
            If i = 1 Then
                vDB = .UsedRange
            Else
                vDB = .UsedRange.Offset(1)
            End If
        End With
        ActiveWorkbook.Close
        Set rngT = Ws.Range("a" & Rows.Count).End(xlUp)(2) ' it's lastrow +1
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next file
    Ws.Range("a1").EntireRow.Delete
    Set FileText = Nothing
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing

End Sub
 

Attachments

Last edited by a moderator:

vletm

Excel Ninja
rkbisht2019
Did You solve Your previous almost same title thread?
Some of Your sent files are same.
 
rkbisht2019
Did You solve Your previous almost same title thread?
Some of Your sent files are same.
No Dear...I believe you understand my requirement. Although, both threads have different code. But, if someone can provide solutions either of any code, will really appreciate and be very thankful to him/her.
 

vletm

Excel Ninja
rkbisht2019
You wrote that Your code works perfect ... but it seems missing some features.
I will skip all fso-something - those maybe works with Windows - I've read so.
Why do You have this line? Ws.Range("a1").EntireRow.Delete
But, as soon as execution completes first row is vanished and data is pasted.
Have You shown somewhere somehow Your expected results?
 
rkbisht2019
You wrote that Your code works perfect ... but it seems missing some features.
I will skip all fso-something - those maybe works with Windows - I've read so.
Why do You have this line? Ws.Range("a1").EntireRow.Delete
But, as soon as execution completes first row is vanished and data is pasted.
Have You shown somewhere somehow Your expected results?
Dear,
Please download the files I have shared and edit path for import and cick on import button, you will notice that as soon as data is retrieved from three .text files, Import button and highlighted header both lines are vanished. Also, you may provide alternative code for this, if my code seems inappropriate.
 

vletm

Excel Ninja
rkbisht2019
Did You read my writing?
> I will skip all fso-something - ... seems You skipped.
> Why do You have this line? ... means ... have You copy & pasted Your code somewhere?
If You cannot know expected results
... then how You could write that something is missing ... or something should be different?
or how could I or someone else do something?
 
Top