@ Rudi Fehler im macro
buliwyf
leider scheint das macro doch einen Fehler zu haben und zwar folgenden.
Nachdem sich die Zahl in der Spalte A aendert soll eine leerzeile eingefuegt werden.
Nur leider wird nicht nur eine leerzeile zwischen den verschiedenen Zahlen eingefuegt sondern leider jedesmal die erste der neuen Zahl komplett ueberschrieben, geloescht ?
Zur Erinnerung:
so sah es vorher aus. (die Daten, Zahlen werden aus einer csv importiert)
1402 mo
1402 di
1402 mi
1403 mo
1403 di
1404 mo
1404 di
1405 mo
1405 di
Und hinterher sollte es so aussehen:
1402 mo
1402 di
1402 mi
1403 mo
1403 di
1404 mo
1404 di
1405 mo
1405 di
Nur leider wird jedes mal die erste neue Zeile komplett ueberschrieben.
so das dann immer wie bereits gesagt die erste neue Zeile komplett fehlt, was nat. nicht unbedingt gut ist.
(die mo, di, mi sind jetzt mal nur zu veranschaulichung gedacht, nornmalerweise steht dahinter dann ein Buchtitel)
1402 di
1402 mi
1403 di
1404 di
1405 di
Jemand eine Idee ?
Hier mal das gesamte macro.
Sub Auto_Open()
Dim strDatei As String, strPfad As String, sFile As String
Dim strText, arrHeader, iCounter As Integer, strDelim As String
Dim vntKunde, vntTmp
arrHeader = Array("KdNr", "EAN", "Titel", "Anzahl", "Auftragsnummer")
strPfad = "c:\thueringen\"
strDatei = "Bestellung_" & Format(Date, "dd.mm.yyyy") & ".xls"
sFile = Dir(strPfad & "*.txt")
If sFile "" Then
Application.ScreenUpdating = False
Open strPfad & sFile For Input As #1
strText = Split(Input(LOF(1), 1), vbCrLf)
Close #1
If InStr(strText(0), vbTab) > 0 Then
strDelim = vbTab
Else
strDelim = ";"
End If
With Workbooks.Add.Sheets(1)
If Join(arrHeader, strDelim) strText(0) Then
.Cells(1, 1).Resize(, 5) = arrHeader
End If
vntKunde = Split(strText(0), strDelim)(0)
For iCounter = 0 To UBound(strText)
vntTmp = Split(strText(iCounter), strDelim)
If UBound(vntTmp) > -1 Then
.Cells(iCounter + 2 - (vntKunde vntTmp(0)), 1).Resize(, 5) = vntTmp
vntKunde = vntTmp(0)
End If
Next
With .Parent
.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\*\Eigene Dateien\" _
& "Winline\Winline_Abfragen\*\Bestellungen\" & strDatei
.Close
End With
End With
End If
End SubRegards /Stef