Dann nutze mal den Code. Der macht nix, wenn nur ein Zeile vorhanden ist. VG

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
  
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