AW: CSV Import Problem
24.04.2022 15:06:27
Nepumuk
Hallo Beat,
bitteschön:
Sub TextImport()
Dim Counter As Integer
Dim LastRow As Long
Dim LastRow_1 As Long
Dim OpenFile As Variant
Dim wks As Worksheet
'bevor importiert wird, werden alle vorherigen Werte gelöscht
ActiveSheet.Cells.Delete
'Datei öffnen Dialog, voreingestellt auf nur Textdateien
OpenFile = Application.GetOpenFilename("Textdateien (*.txt), *.txt", , , , True)
'For-Schleife, beginnend bei 1 endend bei max. Zahl der Dateien in Variable OpenFile
For Counter = 1 To UBound(OpenFile)
'Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
'Überprüfung ob letzte Zelle in Spalte A leer ist
If IsEmpty(Cells(65536, 1)) Then
'Es wird in der Folge solange nach oben gegangen,
'bis ein Inhalt in einer Zelle gefunden wird
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Die Fundstelle wird in einer Messagebox ausgegeben
' MsgBox "Letzter Eintrag in Zeile: " & LastRow
'und in eine Variable Namens LastRow_1 geschrieben und 1 addiert
'um die nächste freie Zelle anzugeben
LastRow_1 = LastRow + 1
Else
'wenn die letzte Zelle belegt ist, erfolgt eine Info
'und das Ende des Programms
MsgBox "Die letzte Zelle ist nicht leer!", vbCritical, "Bitte beachten!"
End If
Set wks = ActiveSheet
Workbooks.Open Filename:=OpenFile(Counter)
ActiveSheet.UsedRange.Copy wks.Range("A" & LastRow_1)
ActiveWorkbook.Close savechanges:=False
Next Counter
'notwendig, da während der Schleife beim ersten Durchlauf
'an der Stelle LastRow_1 = LastRow + 1 in Zeile 2 begonnen wird und somit
'Zeile 1 leer bleibt.
wks.Rows("1:1").Delete
wks.Range("A1").Select
Call Columns(1).TextToColumns(Destination:=Range("A1"), DataType:=xlDelimited, _
ConsecutiveDelimiter:=False, Semicolon:=True, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)))
End Sub
Gruß
Nepumuk