Diffizieler Code :-)
27.02.2008 17:51:00
Frederic
wie kriege ich denn in diesen bestehenden Code noch meinen Export rein?
Sub verschieben()
Dim rng As Range
Dim ALetzte As Long
'Sheets("Liste").Range("L401").Value = ComboBox1.Value
'##Spalte L nach A einfügen, um das Verschieben zu gewährleisten
Sheets("Liste").Visible = True
Sheets("Liste").Select
Columns("K:K").Select
Selection.Copy
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A7").Select
'## Letzte nichtleere Zelle in Spalte A ermitteln
ALetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
'## Einträge verschieben
For Each rng In Sheets("Liste").Range("A7:A" & ALetzte)
If rng = Range("M401") Then Range(Cells(rng.Row, 1), _
Cells(rng.Row, 12)).Insert Shift:=xlToRight
Next
'##Spalte A wieder löschen
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A7").Select
'##Kopiervorgang in das jeweilige Archiv-Sheet
Sheets("Liste").Select
With Sheets(Range("L401").Text)
.Range("A7:K400").Value = Range("L7:W400").Value
.Range("L1").FormulaR1C1 = "=SUM(C[-7])" ' trägt die _
Summenberechnung in K1 ein
.Range("D1:D400").NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 " ' formatiert die _
Betragspalte D
.Range("A1:K" & .Cells(Rows.Count, 2).End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).Delete xlUp
.Columns(1).Delete
End With
'##Leerzeilen in Liste wieder löschen, damit die aktuellen Buchungen sauber dastehen
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'##Code für den Export in die TXT-Datei
End Sub
Der Export sollte als TXT-File mit ";" als Trennzeichen immer unter: C:\tool\export.txt
abgelegt werden?
Ist das möglich oder kann ich mich von dem Gedanken verabschieden?
Tausend Dank im voraus für Eure Hilfen.
Frederic