Import multiple text files to a new row in excel u

2019-06-09 12:55发布

问题:

I have the following code which scans my directory for text files. In my directory there are several text files each laid out like so:

Text File:
Birmingham
France
Isle of White
Manchester
New-Castle

I am then trying to import each text file to a new row in excel and so that each line of text is inserted into a new column within that row.

Birmingham         France      Isle of White       Manchester     New-Castle

The code I have does this, however it is only importing one text file and is not importing all of the text files in the directory.

Please can someone show me where I am going wrong? I should be getting the following result:

Row 1
Birmingham         France      Isle of White       Manchester     New-Castle 

Row 2
London             Spain       America             Sutton         Scotland

etc...

Code:

Sub Import_All_Text_Files_2007()

    Dim nxt_row As Long

     'Change Path
    Const strPath As String = "Z:\NS\Unactioned\"
    Dim strExtension As String

     'Stop Screen Flickering
    Application.ScreenUpdating = False

    ChDir strPath

     'Change extension
    strExtension = Dir(strPath & "*.txt")

    Do While strExtension <> ""


         'Sets Row Number for Data to Begin
        nxt_row = Range("A1").End(xlUp).Offset(0, 0).Row

         'Below is from a recorded macro importing a text file
        FileNum = FreeFile()
curCol = 1
Open strPath & strExtension For Input As #FileNum
While Not EOF(FileNum)
    Line Input #FileNum, DataLine
    ActiveSheet.Cells(nxt_row, curCol) = DataLine
    curCol = curCol + 1
Wend
Close #FileNum

        strExtension = Dir
    Loop

    Application.ScreenUpdating = True

End Sub

回答1:

I think your issue is with this row:

 nxt_row = Range("A1").End(xlUp).Offset(0, 0).Row

Replace it with this:

 nxt_row = Range("A10000").End(xlUp).Offset(1, 0).Row

Or an alternative:

if Range("A1").Value = "" then 
  nxt_row = 1
else
  if Range("A2").Value = "" then 
    nxt_row = 2
  else
     nxt_row = Range("A1").End(xlDown).Offset(1).Row
  end if
end if