Oktober 24, 2020, 17:36:48

Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!


Wie kann ich die Zeilen per Makro erweitern ?

Begonnen von vincentthomas, April 26, 2020, 22:41:11

⏪ vorheriges - nächstes ⏩

vincentthomas

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

Dex

Mai 20, 2020, 15:46:45 #1 Letzte Bearbeitung: Mai 20, 2020, 16:12:30 von Dex
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