Hallo! Ersetz mal deine Sub durch diese hier. Hinweis noch. Du hast OneLine geprüft, bevor die Zeile ausgelesen war. Dann hast du ein Array auf seine Größe geprüft ohne es zu befüllen (vermtl. mit dem Splitten der OneLine). Dann solltest du bei der Prüfung testen, ob das Array wirklich soviele Elemente hat, wie du ausliest - also 43. Wenn du zwar maehr als 1 hast aber nur 20, kommt beim Zugriff auf Index 21 ein Fehler. Da mal noch schauen. Beim splitten wird ab Index 0 gefüllt. Geht dort also auch los mit zählen. Ich splitte jetzt OneLine mit ; als Trenner. Da mal schauen ob deine CSV das auch als Trenner hat, Wenn nicht, das bitte mal ersetzen.

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

Line Input #hfile, OneLine          ' liest die erste Zeile der csv
         
Line Input #hfile, OneLine          ' liest die zweite Zeile der csv

Close #hfile

Kill fname
                                               
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  'MyArray > 43
       
End If 'OneLIne leer
       
End Sub