1 Sub Export()

  2     Dim FileName As Variant

  3     Dim Sep As String

  4     Dim StartSheet As Integer

  5     Dim EndSheet As Integer

  6     

  7     Dim ExportIndex As Integer

  8     

  9     ' 

 10     FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")

 11     If FileName = False Then

 12         ''''''''''''''''''''''''''

 13         ' user cancelled, get out

 14         ''''''''''''''''''''''''''

 15         Exit Sub

 16     End If

 17     ' 

 18    ' Sep = Application.InputBox("Enter a separator character.", Type:=2)

 19     

 20     ' Sheet

 21     'StartSheet = Application.InputBox(" Sheet.", Type:=2)

 22     ' Sheet

 23     EndSheet = Application.InputBox(" Sheet.", Type:=2)

 24     

 25     ' 

 26     ExportIndex = Application.InputBox(" .", Type:=2)

 27    

 32     ShartSheet:=StartSheet, EndSheet:=EndSheet, ExportRow:=ExportIndex

 33      ExportRangeToTextFile FName:=CStr(FileName), SelectionOnly:=False, AppendData:=False, _

 34     ShartSheet:=1, EndSheet:=EndSheet, ExportRow:=ExportIndex

 35 End Sub

 36 

 37 

 38 

 39 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 40 '  Excel Sheet Text

 41 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 42 Public Sub ExportRangeToTextFile(FName As String, _

 43     SelectionOnly As Boolean, _

 44     AppendData As Boolean, ShartSheet As Integer, _

 45     EndSheet As Integer, ExportRow As Integer)

 46 

 47 Dim WholeLine As String

 48 Dim FNum As Integer

 49 Dim RowNdx As Long

 50 Dim ColNdx As Integer

 51 Dim StartRow As Long

 52 Dim EndRow As Long

 53 Dim StartCol As Integer

 54 Dim EndCol As Integer

 55 Dim CellValue As String

 56 Dim X As Variant

 57 

 58 Application.ScreenUpdating = False

 59 On Error GoTo EndMacro:

 60 FNum = FreeFile

 61  Open FName For Output Access Write As #FNum

 62 

 63 For i = 1 To Application.sheets.Count

 64     X = Application.sheets(i).UsedRange.Value

 65     WholeLine = ""

 66    With Application.sheets(i).UsedRange

 67         StartRow = .Cells(1).Row

 68         StartCol = .Cells(1).Column

 69         EndRow = .Cells(.Cells.Count).Row

 70         EndCol = .Cells(.Cells.Count).Column

 71     End With

 72     

 73     For j = 1 To EndCol

 74         WholeLine = WholeLine + X(ExportRow, j) + Chr("9") '\t

 75     Next

 76     Print #FNum, WholeLine

 77 Next

 78     MsgBox "OK" '

 79 EndMacro:

 80 On Error GoTo 0

 81 Application.ScreenUpdating = True

 82 Close #FNum

 83 'XT = Application.Transpose(X) 

 84 

 85 End Sub

 86 

 87 

 88 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 89 '  sheet

 92 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 93 Public Sub ExportSingleSheetToTextFile(FName As String, _

 94     Sep As String, SelectionOnly As Boolean, _

 95     AppendData As Boolean)

 96 

 97 Dim WholeLine As String

 98 Dim FNum As Integer

 99 Dim RowNdx As Long

100 Dim ColNdx As Integer

101 Dim StartRow As Long

102 Dim EndRow As Long

103 Dim StartCol As Integer

104 Dim EndCol As Integer

105 Dim CellValue As String

106 

107 

108 Application.ScreenUpdating = False

109 On Error GoTo EndMacro:

110 FNum = FreeFile

111 

112 If SelectionOnly = True Then

113     With Selection

114         StartRow = .Cells(1).Row

115         StartCol = .Cells(1).Column

116         EndRow = .Cells(.Cells.Count).Row

117         EndCol = .Cells(.Cells.Count).Column

118     End With

119 Else

120     With ActiveSheet.UsedRange

121         StartRow = .Cells(1).Row

122         StartCol = .Cells(1).Column

123         EndRow = .Cells(.Cells.Count).Row

124         EndCol = .Cells(.Cells.Count).Column

125     End With

126 End If

127 

128 If AppendData = True Then

129     Open FName For Append Access Write As #FNum

130 Else

131     Open FName For Output Access Write As #FNum

132 End If

133 

134 For RowNdx = StartRow To EndRow

135     WholeLine = ""

136     For ColNdx = StartCol To EndCol

137         If Cells(RowNdx, ColNdx).Value = "" Then

138             CellValue = Chr(34) & Chr(34)

139         Else

140            CellValue = Cells(RowNdx, ColNdx).Value

141         End If

142         WholeLine = WholeLine & CellValue & Sep

143     Next ColNdx

144     WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))

145     Print #FNum, WholeLine

146 Next RowNdx

147 

148 EndMacro:

149 On Error GoTo 0

150 Application.ScreenUpdating = True

151 Close #FNum

152 

153 End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'  Excel Sheet New Sheet

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub ExportRangeToNewSheet(FName As String, _

    SelectionOnly As Boolean, _

    AppendData As Boolean, ShartSheet As Integer, _

    EndSheet As Integer, ExportRow As Integer)

Dim FNum As Integer

Dim RowNdx As Long

Dim ColNdx As Integer

Dim StartRow As Long

Dim EndRow As Long

Dim StartCol As Integer

Dim EndCol As Integer

Dim CellValue As String

Dim X As Variant

Dim Xsheet As Worksheet



Set Xsheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

Xsheet.Name = FName 'Format(Now(), "HHmmss")



Application.ScreenUpdating = False



Dim index As Integer

 index = 1

'For i = 1 To Application.Sheets.Count

For i = ShartSheet To EndSheet 'Application.Sheets.Count

   With Application.Sheets(i).UsedRange

        EndCol = .Cells(.Cells.Count).Column

    For j = 1 To EndCol

        Xsheet.Cells(j, 2 * index - 1).Value = .Cells(1, j).Text

        Xsheet.Cells(j, 2 * index).Value = .Cells(ExportRow, j).Text

    Next

    End With

    index = index + 1

Next

    MsgBox " OK，Sheet " + FName '

'XT = Application.Transpose(X) 



End Sub

Sub OpenFile()



 Dim filter As String

    Dim fileToOpen

   

    filter = "All Files(*.*),*.*,Word Documents(*.do*),*.do*," & _

            "Text Files(*.txt),*.txt"

    fileToOpen = Application.GetOpenFilename(filter, 4, " ")

   

    If fileToOpen = False Then

        MsgBox " ", vbOKOnly, " "

    Else

    

     ' Workbooks.Open FileName:=fileToOpen

     '   MsgBox " ：" & fileToOpen, vbOKOnly, " "

       With ActiveSheet.QueryTables.Add(Connection:= _

        "TEXT;" + fileToOpen, Destination:=Range("$A$1") _

        )

        .Name = "Sample"

        .FieldNames = True

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .RefreshStyle = xlInsertDeleteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .TextFilePromptOnRefresh = False

        .TextFilePlatform = 437

        .TextFileStartRow = 1

        .TextFileParseType = xlDelimited

        .TextFileTextQualifier = xlTextQualifierDoubleQuote

        .TextFileConsecutiveDelimiter = False

        .TextFileTabDelimiter = True

        .TextFileSemicolonDelimiter = False

        .TextFileCommaDelimiter = True

        .TextFileSpaceDelimiter = False

        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

        .TextFileTrailingMinusNumbers = True

        .Refresh BackgroundQuery:=False

    End With

    End If

End Sub

vba: Importing text file into excel sheet

Using a QueryTable





Sub Sample()

    With ActiveSheet.QueryTables.Add(Connection:= _

        "TEXT;C:\Sample.txt", Destination:=Range("$A$1") _

        )

        .Name = "Sample"

        .FieldNames = True

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .RefreshStyle = xlInsertDeleteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .TextFilePromptOnRefresh = False

        .TextFilePlatform = 437

        .TextFileStartRow = 1

        .TextFileParseType = xlDelimited

        .TextFileTextQualifier = xlTextQualifierDoubleQuote

        .TextFileConsecutiveDelimiter = False

        .TextFileTabDelimiter = True

        .TextFileSemicolonDelimiter = False

        .TextFileCommaDelimiter = True

        .TextFileSpaceDelimiter = False

        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

        .TextFileTrailingMinusNumbers = True

        .Refresh BackgroundQuery:=False

    End With

End Sub

Open the text file in memory



Sub Sample()

    Dim MyData As String, strData() As String



    Open "C:\Sample.txt" For Binary As #1

    MyData = Space$(LOF(1))

    Get #1, , MyData

    Close #1

    strData() = Split(MyData, vbCrLf)

End Sub

Once you have the data in the array you can export it to the current sheet.



Using the method that you are already using



Sub Sample()

    Dim wbI As Workbook, wbO As Workbook

    Dim wsI As Worksheet



    Set wbI = ThisWorkbook

    Set wsI = wbI.Sheets("Sheet1") '<~~ Sheet where you want to import



    Set wbO = Workbooks.Open("C:\Sample.txt")



    wbO.Sheets(1).Cells.Copy wsI.Cells



    wbO.Close SaveChanges:=False

End Sub

FOLLOWUP



You can use the Application.GetOpenFilename to choose the relevant file. For example...



Sub Sample()

    Dim Ret



    Ret = Application.GetOpenFilename("Prn Files (*.prn), *.prn")



    If Ret <> False Then

        With ActiveSheet.QueryTables.Add(Connection:= _

        "TEXT;" & Ret, Destination:=Range("$A$1"))



            '~~> Rest of the code



        End With

    End If

End Sub