import of txt list to Excel
Hello All,
Could anybidy help me with macros for importing txt list of th following forward: Company Name1 Address1 Tel1 Fax1 Email1 Company Name2 Address2 Tel2 Fax2 Email2 ........... Input to Excel file should be: 1. Company name1 - Address1 - Tel1 - Fax1 - Email1 2. Company name2 - Address2 - Tel2 - Fax2 - Email2 ........... Thank you for your assistant -- Message posted from http://www.ExcelForum.com |
import of txt list to Excel
presto,
Assuming you data starts in row 1, and each set is 6 rows down from the previous: Dim rows As Long For rows = 1 To Range("A65536").End(xlUp).Row Step 6 Cells(rows, 1).Resize(6, 1).Copy Range("B65536").End(xlUp)(2).PasteSpecial Transpose:=True Next rows HTH, Bernie MS Excel MVP "presto44 " wrote in message ... Hello All, Could anybidy help me with macros for importing txt list of the following forward: Company Name1 Address1 Tel1 Fax1 Email1 Company Name2 Address2 Tel2 Fax2 Email2 .......... Input to Excel file should be: 1. Company name1 - Address1 - Tel1 - Fax1 - Email1 2. Company name2 - Address2 - Tel2 - Fax2 - Email2 .......... Thank you for your assistant. --- Message posted from http://www.ExcelForum.com/ |
import of txt list to Excel
Try the following, note you need to include the Microsoft Scripting
Runtime to use FileSystemObject Option Explicit ' Requires Tools-References Microsoft Scripting Runtime Public Sub OpenFile() Dim fsoFileSystemObject As FileSystemObject Dim strFileName As String Dim fFile As File Dim tsTextStream As TextStream Dim strLine As String Dim wsNewWorkSheet As Worksheet Dim lRow As Long Set fsoFileSystemObject = CreateObject("Scripting.FileSystemObject") strFileName = Application.GetOpenFilename If strFileName = "False" Then MsgBox "Cancelled" Else Set fFile = fsoFileSystemObject.GetFile(strFileName) Set tsTextStream = fFile.OpenAsTextStream(ForReading) Set wsNewWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count) ) With wsNewWorkSheet .Name = "NewSheet" .Range("A1") = "Company Name" .Range("A1").Offset(0, 1) = "Address" .Range("A1").Offset(0, 2) = "Telephone" .Range("A1").Offset(0, 3) = "Fax" .Range("A1").Offset(0, 4) = "E-mail" End With lRow = 0 Do While Not tsTextStream.AtEndOfStream lRow = lRow + 1 ' Read company name strLine = tsTextStream.ReadLine wsNewWorkSheet.Range("A1").Offset(lRow, 0) = strLine ' Read address strLine = tsTextStream.ReadLine wsNewWorkSheet.Range("A1").Offset(lRow, 1) = strLine ' Read phone number strLine = tsTextStream.ReadLine wsNewWorkSheet.Range("A1").Offset(lRow, 2) = strLine ' Read fax number strLine = tsTextStream.ReadLine wsNewWorkSheet.Range("A1").Offset(lRow, 3) = strLine ' Read email address strLine = tsTextStream.ReadLine wsNewWorkSheet.Range("A1").Offset(lRow, 4) = strLine If Not tsTextStream.AtEndOfStream Then tsTextStream.SkipLine Loop tsTextStream.Close End If End Sub *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
All times are GMT +1. The time now is 11:07 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com