excel to csv

'Speichern mit ";" als Trennzeichen
Sub SaveCSVSemicolon()
Dim rngBereich As Range
Dim rngZeile As Range
Dim rngZelle As Range
Dim strTemp As String
Dim strPfad As String

strPfad = ThisWorkbook.Path + "\"

Const strDateiname As String = "csv_file"
Const strErweiterung As String = ".csv"
Const strTrennzeichen As String = ";"

   Set rngBereich = ActiveSheet.UsedRange 'Nur die gefüllten Zellen
   Open strPfad & strDateiname & strErweiterung For Output As #1

   For Each rngZeile In rngBereich.Rows
     For Each rngZelle In rngZeile.Cells
       'Zellen, die ein "www" oder "http(s)" beinhalten in html a-Tags ändern
       If ((InStr(1, rngZelle.Text, "www") > 0) Or (InStr(1, rngZelle.Text, "http") > 0)) Then
         strTemp = strTemp & "<a href=""" & CStr(rngZelle.Text) & """>" & "Kartoffel" & "</a>;"""
       Else
         strTemp = strTemp & CStr(rngZelle.Text) & strTrennzeichen
       End If

     Next
     Print #1, strTemp

     strTemp = ""
   Next

   Close #1
   Set rngBereich = Nothing
End Sub