.txt to separate worksheets

Question

I'm trying to use the following code to import multiple .txt into separate separate sheets in a workbook. In all of the worksheets it fails to space delimit the last row and from worksheet 2 onward it also fails to copy the first line of the .txt file. All the txt. files are the exactly the same format. Any help appreciated.

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, OtherChar:="|"

        Dim lastrowA As Long
        Dim lastrowB As Long
        Dim sheetname As String

        With ActiveSheet
            lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
            sheetname = ActiveSheet.Name
            Range("a1").EntireColumn.Insert
            Range("a1").Value = sheetname
            Range("a2" & ":a" & lastrowB).Value = Range("a1")
            Range("a1").EntireRow.Insert
        End With


    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False

        End With


    With ActiveSheet
            lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
            sheetname = ActiveSheet.Name
            Range("a1").Value = sheetname
            Range("a2" & ":a" & lastrowB).Value = Range("a1")
            Range("a1").EntireRow.Insert
    End With

        x = x + 1

    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler



End Sub

score 0 · Answer 1 · answered Jun 18 '18 at 14:12

0

If you make a minimal, complete, and verifiable example, you would probably find the mistake yourself. However, by your description for the first row, I guess the problem is here:

With ActiveSheet
    lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
    sheetname = ActiveSheet.Name
    Range("a1").EntireColumn.Insert
    Range("a1").Value = sheetname
    Range("a2" & ":a" & lastrowB).Value = Range("a1")
    Range("a1").EntireRow.Insert
End With

You need to declare the ranges like this:

With ActiveSheet
    lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
    sheetname = ActiveSheet.Name
    .Range("a1").EntireColumn.Insert
    .Range("a1").Value = sheetname
    .Range("a2" & ":a" & lastrowB).Value = .Range("a1")
    .Range("a1").EntireRow.Insert
End With

See the dots, they make the difference. If the code is located in a worksheet, then the ranges take the worksheet they are located to, as a Parent worksheet.

answered Jun 18 '18 at 14:12

Vityata

42,633
8
55
100

1

Thanks Vityata. Missed the range problem (its sorted now, thanks), but I still can't work out why the last row is not delimited – Ian Jun 18 '18 at 14:20
@Ian - is the last row everywhere not delimited? I guess it should be ok, on the `ActiveSheet`. In general, read this and rewrite the whole code avoiding `ActiveSheet`, it may work - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – Vityata Jun 18 '18 at 14:26
The activesheet sections are just some labels I need but I'll rewrite and remove them. Even without the activesheet section none of the last rows on any sheets are delimited – Ian Jun 18 '18 at 14:29
@Ian you should mark it as answer if Vityata gave u a solution. – 1986G1988 Jun 18 '18 at 14:54
@george86 Still trying to sort out the last line not being delimited otherwise I would have – Ian Jun 18 '18 at 14:58
@Ian - put a screenshot, it would be easier. – Vityata Jun 18 '18 at 14:59
@Ian I am sorry, I saw your comment "Thanks Vityata. Missed the range problem (its sorted now, thanks), " & thought it is solved...Didn't read that completely – 1986G1988 Jun 18 '18 at 15:15

.txt to separate worksheets

1 Answers1