Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: VBA: Zeile auswählen, kopieren und x-fach einfügen

VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 09:24:47
Roman_braucht_Hilfe
Hallo zusammen

ich stehe an und brauche Hilfe...
Ausgangslage: Ich mach die Einsatzplanung für einen Anlass. Die Bereichsleiter haben mir ihren Personalbedarf gemeldet: Pro Einsatzart eine Zeile, jedoch kann jeder Einsatz auch mehrere Personen benötigen (Spalte E "Anz. Personen").
Aufgabe: Ich muss für jede Person eine einzelne Zeile bekommen (Kopieren und Einfügen). Somit muss jede Zeile geprüft werden, welche Anzahl drin steht und wenn >1 dann muss die Zeile kopiert und entsprechend häufig eingefügt werden.
Ziel: ein VBA-Script, dass ich nach jeder Aktualisierung*) ausführen kann

*) immer basierend von der Originaldatei, die noch laufend angepasst wird. Der Script läuft dann immer auf einer Kopie.

Die Musterdatei ist gekürzt, Original deutlich umfangreicher (ca. 400 Zeilen)
https://www.herber.de/bbs/user/165754.xlsm

Vielen Dank für die Unterstützung!
Roman
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 09:50:18
Beverly
Hi Roman,

vielleicht so:

Sub Einfuegen()

Dim lngZeile As Long
Dim lngAnzahl As Long
For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(lngZeile, 5) > 1 Then
lngAnzahl = Cells(lngZeile, 5)
Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1)).EntireRow.Insert
Range(Cells(lngZeile, 1), Cells(lngZeile, 17)).Copy Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1))
End If
Next lngZeile
End Sub


Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 17:25:45
Roman_braucht_Hilfe
Herzlichen Dank an Karin & Hary

ihr habt mir richtig gut geholfen und ein Riesenproblem für mich gelöst!

Guten Rutsch ins neue Jahr!
Roman
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 11:08:05
Roman_braucht_Hilfe
Hi Karin,

wow, super und so schnell - Danke funktioniert soweit!
das Makro funktioniert bleibt aber "hängen" (schliesst sich nicht). Der Fehler:

Laufzeitfehler '13'
Typen unverträglich

Beim Debuggen zeigt er auf diese Zeile:
lngAnzahl = Cells(lngZeile, 5)

stört mich nicht gross, da die Aufgabe ja richtig erledigt wurde.

Falls möglich, hätte ich noch folgende zwei "ergänzende" Wünsche:
- Spalte E (Anz. Personen) im Anschluss auf 1 setzen (nach dem kopieren, sodass die Summe über die Anzahl Personen immer noch stimmt)
- Spalte O (Zeilen-ID): super toll wäre es, wenn die ID mit einer fortlaufenden Nummer erweiterter werden könnte (z.B: wird aus "030-21-x5" --> "030-21-x5-1", "030-21-x5-2" usw.

Herzlichen Dank für die professionelle geniale und rasche Lösung
Roman

Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 11:13:54
hary
Moin
Für Problem 1
Mach aus der 1 eine 2
For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

gruss hary
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 11:39:23
Roman_braucht_Hilfe
Hallo Hary,

vielen Dank - der Fehler ist damit behoben.

@alle: wäre toll, die anderen 2 "Problemchen" noch gelöst zu bekommen... :-)

PS: Super Forum&Community!
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 12:50:20
hary
Moin
Sollte passen.
Sub Einfuegen()

Dim lngZeile As Long, lngAnzahl As Long, zaehler As Long
Dim Zelle As Range
Application.ScreenUpdating = False
For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(lngZeile, 5) > 1 Then
zaehler = 1
lngAnzahl = Cells(lngZeile, 5)
Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1)).EntireRow.Insert
Range(Cells(lngZeile, 1), Cells(lngZeile, 17)).Copy Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1))
Range(Cells(lngZeile, 5), Cells(lngZeile + lngAnzahl - 1, 5)) = 1
For Each Zelle In Range(Cells(lngZeile, 15), Cells(lngZeile + lngAnzahl - 1, 15))
Zelle = Left(Zelle, InStr(1, Zelle, "x")) & zaehler
zaehler = zaehler + 1
Next
End If
Next lngZeile
End Sub

gruss hary
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 13:04:00
Roman_braucht_Hilfe
Hallo Hary, hallo Karin

Danke, super!

ich habe nun zwei Versionen, die sehr gut sind, aber....

Lösung Hary: Der Zähler ist zusätzlich gedacht nicht als Ersatz des vorhandenen "x5" - dies wurde durch die Lösung von Karin gelöst
Lösung Karin: Die Anzahl Personen sind nicht auf 1 gesetzt - bei Hary hingegen gelöst..

ich wage nicht, in die Codes einzugreifen - vielleicht kann mir jemand von Euch das jeweils fehlende noch ergänzen...

Vielen Dank euch zwei! Gruss
Roman
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 13:22:53
hary
Moin
Sub Einfuegen()

Dim lngZeile As Long, lngAnzahl As Long, zaehler As Long
Dim Zelle As Range
Application.ScreenUpdating = False
For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(lngZeile, 5) > 1 Then
zaehler = 1
lngAnzahl = Cells(lngZeile, 5)
Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1)).EntireRow.Insert
Range(Cells(lngZeile, 1), Cells(lngZeile, 17)).Copy Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1))
Range(Cells(lngZeile, 5), Cells(lngZeile + lngAnzahl - 1, 5)) = 1
For Each Zelle In Range(Cells(lngZeile, 15), Cells(lngZeile + lngAnzahl - 1, 15))
Zelle = Zelle & "-" & zaehler
zaehler = zaehler + 1
Next
End If
Next lngZeile
End Sub

gruss hary
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 12:56:06
Beverly
Hi Roman,

ändere den Code wie folgt:

Sub Einfuegen()

Dim lngZeile As Long
Dim lngAnzahl As Long
Dim strID As String
Dim lngZiel As Long
Dim lngZaehler As Long
For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(lngZeile, 5) > 1 Then
lngAnzahl = Cells(lngZeile, 5)
Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1)).EntireRow.Insert
Range(Cells(lngZeile, 1), Cells(lngZeile, 17)).Copy Range(Cells(lngZeile + 1, 1), Cells(lngZeile + lngAnzahl - 1, 1))
For lngZiel = lngZeile To lngZeile + lngAnzahl - 1
lngZaehler = lngZaehler + 1
Cells(lngZiel, 15) = Cells(lngZiel, 15) & "-" & lngZaehler
Next lngZiel
lngZaehler = 0
End If
Next lngZeile
End Sub


Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 13:04:31
Roman_braucht_Hilfe
Hallo Hary, hallo Karin

Danke, super!

ich habe nun zwei Versionen, die sehr gut sind, aber....

Lösung Hary: Der Zähler ist zusätzlich gedacht nicht als Ersatz des vorhandenen "x5" - dies wurde durch die Lösung von Karin gelöst
Lösung Karin: Die Anzahl Personen sind nicht auf 1 gesetzt - bei Hary hingegen gelöst..

ich wage nicht, in die Codes einzugreifen - vielleicht kann mir jemand von Euch das jeweils fehlende noch ergänzen...

Vielen Dank euch zwei! Gruss
Roman
Anzeige
AW: VBA: Zeile auswählen, kopieren und x-fach einfügen
31.12.2023 13:22:59
Beverly
Hi Roman,

ergänze den Code am Ende um die folgende Zeile:

    Range(Cells(2, 5), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)) = 1



Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige