Sub WriteTextFile()
  Dim FilePath As String
  Dim CellData As String
  Dim LastCol As Long
  Dim LastRow As Long

  LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
  LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
  CellData = ""

  FilePath = Application.DefaultFilePath & "euth.csv"

  Open FilePath For Output As #2

  For i = 1 To LastRow
    For j = 1 To LastCol

      If j = LastCol Then
        CellData = CellData + TrimtActiveCell(i, j).Value)
      Else
        CellData = CellData + TrimtActiveCell(i, j).Value) + ","
      End If

      Next j

      Write #2, CellData
      CellData = ""
    Next i

    Close #2

    MsgBox ("Done")
End Sub