Sub ReadfromCSVSimple(fname As Variant, Optional fs As String = ";")
  
Dim hfile     As Integer   ' Filehandle bzw. Dateinummer
Dim lAnzahl   As Long      ' Zähler über alle Zeilen
Dim OneLine   As String    ' eine Zeile als String
Dim myArr     As Variant   ' eine Zeile in Felder getrennt
Dim myArrRows As Variant  ' Array zum Trennen des csv in mehrere Zeilen
Dim lnglast   As Long
Dim zeichen   As Variant
Dim iCnt      As Integer  'Schleifenzaehler fuer Array. Bei vielen Daten Long nehmen
Dim inhalt
 
ThisWorkbook.Worksheets("Projektübersicht").Select
            
lnglast = Cells(Rows.Count, 1).End(xlUp).Row
            
If IsEmpty(Cells(lnglast, 1)) Then lnglast = Cells(lnglast, 1).End(xlUp).Row
            
lnglast = lnglast + 1 ' ermittelt die erste freie Zeile
            
hfile = FreeFile
    
Open fname For Input As #hfile
   
inhalt = Input(LOF(hfile), hfile)        ' liest alles ein
  
Close #hfile
  msgbox inhalt 
'Kill fname
'nur eine Zeile
If UBound(Split(inhalt, vbCrLf)) = 0 Then Exit Sub
'die zweite zeile
OneLine = Split(inhalt, vbCrLf)(1)
                                                  
If OneLine <> "" Then               ' ist die Zeile NICHT leer, dann...
            
        myArr = Split(OneLine, ";")  '###################  ANPASSEN !!!!!!!!!!!!!!!!!!!!!! ###########################
                                                     
        If UBound(myArr) > 42 Then 'es gibt also 44 Einträge geben , 0 und dan bis 43 = 44, Minimum sind 43
             
            With Worksheets("Projektübersicht")
        .Cells(lnglast, 33) = Replace(myArr(15), Chr$(34), vbNullString) 'Firma/ Name
        .Cells(lnglast, 37) = Replace(myArr(17), Chr$(34), vbNullString) ' Straße
        .Cells(lnglast, 35) = Replace(myArr(18), Chr$(34), vbNullString) ' PLZ
        .Cells(lnglast, 36) = Replace(myArr(19), Chr$(34), vbNullString) 'Ort
        .Cells(lnglast, 38) = Replace(myArr(16), Chr$(34), vbNullString) ' Ansprechpartner
        .Cells(lnglast, 39) = Replace(myArr(20), Chr$(34), vbNullString) ' Telefon
        .Cells(lnglast, 40) = Replace(myArr(22), Chr$(34), vbNullString) ' Mail
        '.Cells(lnglast, 9) = Replace(myArr(64 - 54), Chr$(34), vbNullString)  ' Abwicklung über: Firma/ Name
        '.Cells(lnglast, 13) = Replace(myArr(74 - 54), Chr$(34), vbNullString) ' Straße
        '.Cells(lnglast, 11) = Replace(myArr(2), Chr$(34), vbNullString) ' PLZ:
        '.Cells(lnglast, 12) = Replace(myArr(76 - 54), Chr$(34), vbNullString) ' Ort
        '.Cells(lnglast, 8) = Replace(myArr(77 - 54), Chr$(34), vbNullString) ' Ansprechpartner
        '.Cells(lnglast, 14) = Replace(myArr(78 - 54), Chr$(34), vbNullString) ' Telefon:
        '.Cells(lnglast, 15) = Replace(myArr(79 - 54), Chr$(34), vbNullString) ' Mail
        .Cells(lnglast, 3) = Replace(myArr(23), Chr$(34), vbNullString)  ' BV
        .Cells(lnglast, 7) = Replace(myArr(27), Chr$(34), vbNullString)  ' Straße
        .Cells(lnglast, 5) = Replace(myArr(28), Chr$(34), vbNullString)  ' PLZ
        .Cells(lnglast, 6) = Replace(myArr(29), Chr$(34), vbNullString)   'Ort
        .Cells(lnglast, 16) = Replace(myArr(30), Chr$(34), vbNullString)   'Ansprechpartner
        .Cells(lnglast, 22) = Replace(myArr(31), Chr$(34), vbNullString)   'Telefon
        .Cells(lnglast, 23) = Replace(myArr(33), Chr$(34), vbNullString)   'Mail
             
        '.Cells(lnglast, 42) = Replace(myArr(67 - 54), Chr$(34), vbNullString)    'Wunschtermin
        '.Cells(lnglast, 43) = Replace(myArr(95 - 54), Chr$(34), vbNullString)   'Freitext
        .Cells(lnglast, 31) = "Objekt:" & " " & Replace(myArr(34), Chr$(34), vbNullString) _
           & vbCrLf & "Objekthersteller:" & " " & Replace(myArr(35), Chr$(34), vbNullString) _
           & vbCrLf & "Objektalter:" & " " & Replace(myArr(36), Chr$(34), vbNullString) _
           & vbCrLf & "Trägermaterial:" & " " & Replace(myArr(37), Chr$(34), vbNullString) _
           & vbCrLf & "Oberfläche:" & " " & Replace(myArr(38), Chr$(34), vbNullString) _
           & vbCrLf & "Farbsystem-Nr.:" & " " & Replace(myArr(39), Chr$(34), vbNullString) _
           & vbCrLf & "Glanzgrad:" & " " & Replace(myArr(40), Chr$(34), vbNullString) _
           & vbCrLf & "Schadensumfang:" & " " & Replace(myArr(40), Chr$(34), vbNullString) _
           & vbCrLf & "Schadensort:" & " " & Replace(myArr(41), Chr$(34), vbNullString) _
           & vbCrLf & "Schadensursache:" & " " & Replace(myArr(42), Chr$(34), vbNullString) & vbCrLf & "Schadensbeschreibung:" & " " & Replace(myArr(43), Chr$(34), vbNullString)
             
         
         End With
           
         lnglast = lnglast + 1
           
         End If
        
        
    End If
      
      
    
      
  
    End Sub
  
  
  
  
  
    Private Sub CommandButton1_Click()
    Dim Dateiname  As Variant
  
  
    Dateiname = Application.GetOpenFilename(filefilter:="Textdateien (*.csv), *.csv")
     
     
    If Dateiname <> "Falsch" Or Dateiname <> False Then
      
    Else
      
    Exit Sub
      
    End If
      
      
    Call ReadfromCSVSimple(Dateiname, ";")
     
    Unload UserForm3
    End Sub
  
  
Private Sub CommandButton2_Click()
Unload Me
UserForm4.Show
End Sub
  
Private Sub CommandButton3_Click()
Unload Me
End Sub