Import files into Excel

Sjakalen

New member
Joined
Oct 1, 2012
Messages
3
Reaction score
0
Points
0
Hi there
Please please,, can you help me with the import file macro below
The import part works fine, but when it paste the file into excel, it is not pasted side by side, I need each file to be pasted side by side
I hope someone can help me, this is my macro

Code:
Dim sh As Worksheet, sPath As String, sName As String
 Dim r As Range, fName As String
 Dim sh1 As Worksheet
 With ThisWorkbook
  .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
 End With
 Set sh = ActiveSheet
 With ThisWorkbook
  .Worksheets.Add After:=.Worksheets(.Worksheets.Count)
 End With
 Set sh1 = ActiveSheet
 sPath = "C:\Data\RawData\"
 
sName = Dir(sPath & "*.dat")
 Do While sName <> ""
 sh1.Activate
 fName = sPath & sName
    sh1.Cells.ClearContents
    With sh1.QueryTables.Add( _
       Connection:="TEXT;" & fName, _
        Destination:=sh1.Range("$A$2"))
       .TextFilePlatform = 1252
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = True 'False
       .TextFileSemicolonDelimiter = False 'True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1) 'Array(3, 1, 1, 1)
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
   End With
 Set r = sh.Cells(Rows.Count, 1).End(xlUp)
 If r.Value <> "" Then Set r = r(1)
 sh1.Range("A1").CurrentRegion.Copy
 r.PasteSpecial xlValue
 sName = Dir()
 Loop
 Application.DisplayAlerts = False
  sh1.Delete
 Application.DisplayAlerts = True
 

tommyt61

New member
Joined
Mar 26, 2011
Messages
153
Reaction score
0
Points
0
Try this code



Code:
Sub ImportManyTXTIntoColumns()
'Author:    Jerry Beaucaire
'Date:      2/24/2012
'Summary:   From a specific folder, import files 1 file per column
Dim fPath As String, fTXT As String
Dim wsTrgt As Worksheet, NC As Long
Application.ScreenUpdating = False
fPath = "C:\Data\Rawdata\"
Set wsTrgt = ThisWorkbook.Sheets.Add
NC = 1
fTXT = Dir(fPath & "*.dat")
    Do While Len(fTXT) > 0
                                        
        Workbooks.OpenText fPath & fTXT, Origin:=437
                                        
        wsTrgt.Cells(1, NC) = ActiveSheet.Name
                                        
        Range("A:A").SpecialCells(xlConstants).Copy wsTrgt.Cells(2, NC)
        ActiveWorkbook.Close False
        NC = NC + 1
        fTXT = Dir
    Loop
   
Application.ScreenUpdating = True
End Sub
 

Sjakalen

New member
Joined
Oct 1, 2012
Messages
3
Reaction score
0
Points
0
Hi tommyt
That is a nice code, but it only copy the first column from the dat file, you know why?
 

Sjakalen

New member
Joined
Oct 1, 2012
Messages
3
Reaction score
0
Points
0
I get it
Thanks again TommyT
Code:
Sub ImportManyTXTIntoColumns()
'Author:    Jerry Beaucaire
'Date:      2/24/2012
'Summary:   From a specific folder, import files 1 file per column
Dim fPath As String, fTXT As String
Dim wsTrgt As Worksheet, NC As Long
Application.ScreenUpdating = False
fPath = "C:\Myfolder\MyTextfiles\"
Set wsTrgt = ThisWorkbook.Sheets.Add
NC = 1
fTXT = Dir(fPath & "*N.dat")
    Do While Len(fTXT) > 0
    
        Workbooks.OpenText fPath & fTXT, Origin:=437
        
        wsTrgt.Cells(1, NC) = ActiveSheet.Name
        
        Range("A1").SpecialCells(xlValue).Copy wsTrgt.Cells(2, NC)
        ActiveWorkbook.Close False
        NC = NC + 3
        fTXT = Dir
    Loop
    
Application.ScreenUpdating = True
End Sub
 
Top