Rudi hatte mir am 20.09. bereits geholfen einen Teil des nachfolgenden Codes zusammenzustellen. Dieser bewirkt, dass nur jede zweite Zeile einer .CSV-Datei in
eine Excel-Tabelle (Sheet "KurveA") importiert wird. Jetzt ist es jedoch so, dass ich das Löschen der zweiten Zeile rückgängig machen muss, d.h. es sollen einfach alle Zeilen der .CSV-Datei übertragen werden. Jedoch kann ich das im Code nicht ändern, weil ich nicht weiß wie. Ich habe schon einiges probiert, kam aber nie zum Ziel. Könnt ihr mir bitte weiterhelfen?
Vielen lieben Dank!
Sub Kurve_einfuegen()
'Daten aus .csv kopieren und einfügen
Dim ImportDatei As Variant
Dim WBImport As Workbook
ImportDatei = Application.GetOpenFilename(Filefilter:="CSV Files (*.csv),*.csv,XLS Files (*.xls) _
,*.xls", Title:="Bitte eine CSV- oder XLS-Datei auswählen, um die KurveA einzufügen")
If ImportDatei = False Then Exit Sub
Set WBImport = Workbooks.Open(ImportDatei)
Dim arrIn, arrOut(), i As Long, j As Long, n As Long
arrIn = Range("A1").CurrentRegion
WBImport.Close savechanges:=False
'Jede zweite Zeile löschen
ReDim arrOut(1 To UBound(arrIn), 1 To UBound(arrIn, 2))
For j = 1 To UBound(arrIn, 2)
arrOut(1, j) = arrIn(1, j)
arrOut(2, j) = arrIn(2, j)
Next
n = 1
For i = 3 To UBound(arrIn) Step 2
n = n + 1
For j = 1 To UBound(arrIn, 2)
arrOut(n, j) = arrIn(i, j)
Next j
Next i
With Sheets("KurveA")
.Cells(1, 1).Resize(n, UBound(arrOut, 2)) = arrOut
'Daten in Spalten separieren
.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
TrailingMinusNumbers:=True
End With
With Sheets("Auswertung")
.Range("L16") = Dir(ImportDatei)
End With
Set WBImport = Nothing
End Sub