rkbisht2019
Member
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 <<<
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: