Hallo ich hoffe mir kann jemand bei meinen Problem Helfen da ich noch VBA Neuling bin.
Zu meinen Problem:
Ich möchte aus einer Bestehenden CSV Datei in eine andere Excel importieren.
ich habe im Netz schon mal ein Code gefunden wo für man aber vorher eine Tabelle im Tabellenblatt(Schichten) festlegen bzw. Namen Definieren muss.
Die Daten in der CSV werden durch Semikolons getrennt wenn aber eine Zelle in der CSV Leer ist verschiebt sich natürlich der ganze Import um jeweils die Anzahl der Zellen die leer sind.
Vieleicht kann mir jemand helfen den Code so anzupassen das man nicht mehr vorher den Namen der Tabelle definieren muss und sie der Import nicht mehr bei leeren Celle verschiebt verschiebt.
Vielen dank im Voraus
LG Peter
Private Sub CommandButtonImport_Click()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Title = "Select a CSV File"
.Filters.Add "CSV", "*.csv", 1
.AllowMultiSelect = False
Dim sFile As String
If .Show = True Then
sFile = .SelectedItems(1)
End If
End With
' Import CSV from FileDialog
If sFile <> "" Then
Open sFile For Input As #1
row_number = 0
Do Until EOF(1)
Line Input #1, LineFormFile
LineItems = Split(LineFormFile, ";")
Application.Range("Schichten").Cells(row_number, 1).Value = LineItems(0)
Application.Range("Schichten").Cells(row_number, 2).Value = LineItems(1)
Application.Range("Schichten").Cells(row_number, 3).Value = LineItems(2)
Application.Range("Schichten").Cells(row_number, 4).Value = LineItems(3)
Application.Range("Schichten").Cells(row_number, 5).Value = LineItems(4)
Application.Range("Schichten").Cells(row_number, 6).Value = LineItems(5)
Application.Range("Schichten").Cells(row_number, 7).Value = LineItems(6)
Application.Range("Schichten").Cells(row_number, 8).Value = LineItems(7)
Application.Range("Schichten").Cells(row_number, 9).Value = LineItems(8)
Application.Range("Schichten").Cells(row_number, 10).Value = LineItems(9)
Application.Range("Schichten").Cells(row_number, 11).Value = LineItems(10)
Application.Range("Schichten").Cells(row_number, 12).Value = LineItems(11)
Application.Range("Schichten").Cells(row_number, 13).Value = LineItems(12)
Application.Range("Schichten").Cells(row_number, 14).Value = LineItems(13)
Application.Range("Schichten").Cells(row_number, 15).Value = LineItems(14)
Application.Range("Schichten").Cells(row_number, 16).Value = LineItems(15)
row_number = row_number + 1
Loop
Close #1
End If
End Sub
|