Hallo,
ich komme leider nicht weiter mit meinen Makro Kenntnissen, vielleicht kann mir jemand mit mehr Erfahrungen helfen ?
Anbei auch die Beispiel Datei mit 2 Tabellenblättern.
Ich habe diese Struktur und möchte jedes Konto soweit in den Zeilen fortführen bis die letzten 3 Zahlen bei 999 sind und die 4 Textspalten kopieren:
Ist-Zustand:
Konto Text Text Text Text
0021101901 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021103902 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2
0021105901 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
0021107902 Kontogruppe 4 Kontogruppe 4 Kontogruppe 4 Kontogruppe 4
0042101001 Kontogruppe 5 Kontogruppe 5 Kontogruppe 5 Kontogruppe 5
0042101901 Kontogruppe 6 Kontogruppe 6 Kontogruppe 6 Kontogruppe 6
0021201001 Kontogruppe 7 Kontogruppe 7 Kontogruppe 7 Kontogruppe 7
Soll Zustand:
Konto Text Text Text Text
0021101901 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101902 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101903 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101904 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101905 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101906 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101907 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101908 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
0021101909 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1 Kontogruppe 1
.... Bis die lezten 3 Zahlen 999 sind
0021103902 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2
0021103903 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2
0021103904 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2
0021103905 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2
0021103906 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2 Kontogruppe 2
bis die letzten 3 Zahlen 999 sind
0021105901 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
0021105902 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
0021105903 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
0021105904 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
0021105905 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
0021105906 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3 Kontogruppe 3
bis die letzten 3 Zahlen 999 sind
Bisher konnte ich nur das hier machen aber ich müsste nun immer den Code anpassen:
Dim i As Integer
For i = 1 To 97
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Next i
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A99"), Type:=xlFillDefault
Ich bin für jede Hilfe dankbar
Beachten Sie, dass die erste Spalte als Text formatiert sein muss
Sub CreateListe()
Sheets("Ist").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Dim N As Integer
Dim I As Integer
I = Selection.Rows.Count
Dim num As Integer
Dim nums As String
Dim kont As String
Range("A2").Select
For N = 0 To I - 1
ActiveCell.Offset(N, 0).Range("A1").Select
ActiveCell.Range("A1:E1").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
If IsEmpty(Range("A2")) Then
ActiveCell.Offset(1, 0).Range("A1").Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
End If
ActiveSheet.Paste
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Range("A1:D1").Select
Selection.Copy
Selection.End(xlToLeft).Select
nums = ActiveCell.Value
kont = nums
num = Right(nums, 3)
Do While num < 999
num = num + 1
kont = Left(kont, Len(kont) - 3) & Format(num, "000")
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Value = kont
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Loop
Sheets("Ist").Select
Range("A2").Select
Next N
End Sub