Zeile kopieren wenn Wert...

[Pommel]

Hallo zusammen,
nach ewigem suchen und ausprobieren gebe ich auf und wende mich an euch.
Vermutlich wenn man VBA kann recht einfach, aber ich bekomme es einfach nicht hin.

Ich habe immer wiederkommende Tabellen mit gleich bleibenden Spalten (A-Y) und unterschiedlich vielen Zeilen, teilweise bis zu 2000 Zeilen.

In Spalte i stehen Werte zwischen 1 bis Ende nach oben offen, wird aber wahrscheinlich nie über 30 gehen.

Wenn in Spalte i ein Wert größer 1 steht, soll die entsprechende Zeile (A-Y) kopiert und in einer eingefügten Zeile darunter erscheinen.
Dabei soll die Anzahl der Kopien dem Wert aus Zelle i entsprechen. (Bzw. die Gesamtzahl wie oft diese Zeile jetzt vorhanden ist. Bei 1, keine Kopie, da ein Mal vorhanden, bei 2 eine Kopie, somit 2 Mal vorhanden...)

Sprich:
In i2 steht 1 -> nichts passiert
In i3 steht 2 -> Zeile 3 A-Y wird 1 Mal kopiert und unter Zeile 3 eingefügt
In i4 steht 5 -> Zeile 4 A-Y wird 4 Mal kopiert und unter Zeile 4 eingefügt

Das ganze sollte am besten automatisch passieren sobald die Tabelle A-Y gefüllt wird.
Oder per Makro? Was halt funktioniert.

Für eure Hilfe bin ich wirklich sehr dankbar.

Grüße

[Kuwer]

Hallo Pommel,

z.B. so:

Code:

Sub ZeilenVervielfachen()
  Dim i As Long
  Dim lngZ As Long
  Dim strE As String
  
  Application.ScreenUpdating = False
  For lngZ = Cells(1, 9).CurrentRegion.Rows.Count To 2 Step -1
    strE = Cells(lngZ, 9).Value
    If IsNumeric(strE) Then
      i = CLng(strE)
      Cells(lngZ, 9) = ""
      If i > 1 Then
        Rows(lngZ).Copy
        Rows(lngZ + 1).Resize(i - 1).Insert
      End If
    End If
  Next lngZ
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[Pommel]

Vielen Dank,
das funktioniert ganz genau wie ich mir das vorgestellt habe :)
Das einzige was jetzt noch gut wäre ist, dass der Wert der Anzahl der Kopien nicht gelöscht wird, sondern in dem original bestehen bleibt.
Sprich es steht weiterhin in der ersten Zeile die kopiert wird der Wert und lediglich in den Kopien steht kein Wert mehr drin, oder lieber eine 0 damit man weiß das es sich um eine Kopie handelt.

Also:

Original Zelle A | Zelle B .... Zelle H | 3 | Zelle J ...
Kopie 1 Zelle A | Zelle B .... Zelle H | 0 | Zelle J ...
Kopie 2 Zelle A | Zelle B .... Zelle H | 0 | Zelle J ...

Vielen Dank :)

[Kuwer]

Hallo Pommel,

dann so:

Code:

Sub ZeilenVervielfachen()
  Dim i As Long
  Dim lngZ As Long
  Dim strE As String
  
  Application.ScreenUpdating = False
  For lngZ = Cells(1, 9).CurrentRegion.Rows.Count To 2 Step -1
    strE = Cells(lngZ, 9).Value
    If IsNumeric(strE) Then
      i = CLng(strE)
      If i > 1 Then
        Cells(lngZ, 9).Value = 0
        Rows(lngZ).Copy
        Rows(lngZ + 1).Resize(i - 1).Insert
        Cells(lngZ, 9).Value = i
      End If
    End If
  Next lngZ
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[Pommel]

Mega Uwe, dank dir :)

---

Eine letzte Sache noch um es idiotensicher zu machen:

Wenn der Wert eine Zeile unter dem Wert der geprüft wird null ist, dann nicht kopieren. (Da dann ja bereits kopiert wurde)

Ansonsten kopiert das Makro mit jedem ausführen natürlich die Werte wieder und wieder.

[Kuwer]

Hallo Pommel,

Ansonsten kopiert das Makro mit jedem ausführen natürlich die Werte wieder und wieder.

deswegen mein ursprüngliches Leeren der Zelle(n).

Code:

Sub ZeilenVervielfachen()
  Dim i As Long
  Dim lngZ As Long
  Dim strE As String
  
  Application.ScreenUpdating = False
  For lngZ = Cells(1, 9).CurrentRegion.Rows.Count To 2 Step -1
    strE = Cells(lngZ, 9).Value
    If IsNumeric(strE) Then
      i = CLng(strE)
      If i > 1 Then
        If Cells(lngZ + 1, 9).Value <> 0 * Cells(lngZ + 1, 9).Value <> "" Then
          Cells(lngZ, 9).Value = 0
          Rows(lngZ).Copy
          Rows(lngZ + 1).Resize(i - 1).Insert
          Cells(lngZ, 9).Value = i
        End If
      End If
    End If
  Next lngZ
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[Pommel]

Ah okay ja das macht auf jeden Fall Sinn.
Die angepasste Version ändert bei mir nichts und kopiert trotzdem doppelt. Muss ich da was anders formatieren oder so?

[Kuwer]

Hallo Pommel,

ich habe es getestet und es funktionierte. Mehr kann ich dazu nicht sagen.

Gruß Uwe

[Pommel]

Dann werde ich irgendwo einen Fehler haben, ich suche Mal. Dank dir auf jeden Fall :)