Hey Du....

wie gesagt....so funktioniert es ja nun....nur die Zuordnung stimmt nicht und es werden keine Umlaute geschrieben. Dein Code habe ich getestet, das fenster kommt und die csv steht da drin, dann wieder auf ok und alles ist weg....

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
 
Input #hfile, OneLine          ' liest die erste Zeile der csv
          
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, ";")
                                                   
             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, 3) = Replace(myArr(34), Chr$(61), 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




    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