Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Zeilen mehrfach woandershin kopieren
#1
Hola los todos!

Ich habe eine Liste mit ca. 8000 Zeilen und jeweils vier individuellen Werten (Zellen).

In der Spalte D steht jeweils eine Zahl, der höchste Wert ist 59 der kleinste Wert ist 2.

Gibt es eine Formel wo ich die jeweiligen Zeilen so oft untereinanderschreibe/kopiere wie der Wert in Spalte D lautet?

Also z.B. A1 B1 C1 59 erzeugt 59 x A1 B1 C1 oder:

A1 B1 C1
A1 B1 C1
A1 B1 C1
usw. bis 59x

und danach die Werte aus Zeile 2: A2 B2 C2 z.B. 58 x usw.

Zum Schluss habe ich dann ca. 40.000 Zeilen nach dem Wert in Spalte D gewichtet.
Antworten Top
#2
1.Eine Formel kann nichts kopieren, ausschneiden, verschieben...… Eine Formel kann nur etwas Berechnen und ausgeben!
2.Ja das geht mit VBA problemlos jedoch wäre hier deine Bsp. Datei von Vorteil! 
3.Soll das einmalig passieren oder soll das öfters auf den gleichen Bereich angewendet werden??
Eine Menge reden, aber nichts sagen können viele...
Antworten Top
#3

.xlsx   clever-excel-forum-de-thread-18007-Zeilen mehrfach woandershin kopieren-BEISPIEL.xlsx (Größe: 9,57 KB / Downloads: 5)

Anbei eine Beispieldatei.

Vielen Dank!

Zu 3.) Die ersten drei Werte pro Zeile bzw. die Gesamtmenge der Zeilen bleibt immer gleich nur die Werte in Spalte D können sich verändern = erhöhen oder verringern.
Antworten Top
#4
D.h. Das Makro läuft öfters über den Bereich und soll erkennen, wenn bereits einmal etwas vermehrt wurde?? Wird der obere Beriech mit den Ausgansadressen erweitert, oder sind das alle die dort jemals stehen werden??
Eine Menge reden, aber nichts sagen können viele...
Antworten Top
#5
Die Basisliste bleibt immer gleich, nur die Zahlen in Spalte D würde ich manuell ändern und anschließend das Makro manuell drüberlaufen lassen.
Antworten Top
#6
Hier das Makro zum vermehren..

Code:
Option Explicit
Sub vermeheren()
Dim Last As Integer
Dim i As Integer
Dim c As Integer
Dim count As Integer
Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
Range("A14:D" & Last).Clear
For i = 1 To 12
   
            For c = 1 To CInt(Cells(i, 4).Value)
                   
                    Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row + 1
                   
                    If Last = 13 Then Last = 14 Else Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row + 1
                   
                    Range(Cells(i, 1), Cells(i, 4)).Copy Range(Cells(Last, 1), Cells(Last, 4))
                   
                    Cells(i, 1).Select
            Next

Next
End Sub
Option Explicit


In ein Modul kopieren und dann auf einen Button im Tabellenblatt mit den Daten legen!

P.s. das Selektieren im oberen Bereich war Absicht, um eine Statusrückmeldung für dich zu implementieren!
Eine Menge reden, aber nichts sagen können viele...
Antworten Top
#7
Super! Danke!

Auch auf die Gefahr hin, das ich heute hier zum zweiten Mal darauf hingewiesen werde, das ich das mit dem Makro, Modul, der Schaltfläche oder was auch immer alleine hinkriege und bei G**gle steht wie es geht.

Ich kriege es einfach nicht hin.

Ich habe es heute vor mittag bei einem anderen Code hier im Forum schon mehrfach versucht.

Würdest Du mir das Ganze mit Makro, Modul, Schaltfläche oder was auch immer ich benötige schicken?

Vielen, lieben Dank
Antworten Top
#8
wenn du dich im Bereich VBA etwas weiterbilden möchtest kann ich dir diesen: https://www.youtube.com/channel/UCsECQhL...pOiuQ9rE7g Videokanal auf YouTube empfehlen! 

im Anhang findest du die fertige Datei mit Button!
Eine Menge reden, aber nichts sagen können viele...
Antworten Top
#9
Moin Frogger!

Herzlichen Dank für die Datei!

Ich bekomme bei Zeile 834 bzw. 24.000 daraus generierten Zeilen immer den "Laufzeitfehler 6 Überlauf".

Ich habe hier im Forum schon geschaut und es mit .CountLarge probiert, aber der Fehler tritt immer noch auf.

Anbei mein modifizierter Code:

Sub vermeheren()
Dim Last As Integer
Dim i As Integer
Dim c As Integer
Dim count As Integer

Last = ActiveSheet.Cells(Rows.CountLarge, 1).End(xlUp).Row

Range("A7828:D" & Last).Clear

For i = 1 To 7829
            
            Cells(i, 1).Select

            For c = 1 To CInt(Cells(i, 4).Value)
                    
                    Last = ActiveSheet.Cells(Rows.CountLarge, 1).End(xlUp).Row + 1
                    
                    If Last = 7828 Then Last = 7829 Else Last = ActiveSheet.Cells(Rows.CountLarge, 1).End(xlUp).Row + 1
                    
                    Range(Cells(i, 1), Cells(i, 4)).Copy Range(Cells(Last, 1), Cells(Last, 4))
            
                    
            Next


Next

MsgBox "Fertig!"

End Sub
Antworten Top
#10
Code:
Range("A7828:D" & Last).Clear
 
Das ist denke ich mehr als falsch.. Der Codesatz löscht die Werte von Zelle A7828 bis zur letzten Zeile in D ! 

wo ist denn deine letzte Zeile?? 

Code:
For i = 1 To 7829

If Last = 7828 Then Last = 7829 Else Last = ActiveSheet.Cells(Rows.CountLarge, 1).End(xlUp).Row + 1

Das ist auch sehr falsch weil das weit über den Oberen Bereich hinaus schießt! ( das dürfen nur die Stammdaten sein die du kopieren möchtest! )

du solltest dich vielleicht etwas einlesen in VBA....

versuche diesen Code


Code:
Option Explicit

Sub vermeheren()
Dim Last As Long
Dim i As Long
Dim c As Long
Dim count As Long

Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row

Range("A14:D" & Last).Clear

For i = 1 To 12
           
           Cells(i, 1).Select

           For c = 1 To CInt(Cells(i, 4).Value)
                   
                   Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row + 1
                   
                   If Last = 13 Then Last = 14 Else Last = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row + 1
                   
                   Range(Cells(i, 1), Cells(i, 4)).Copy Range(Cells(Last, 1), Cells(Last, 4))
           
                   
           Next


Next

MsgBox "Fertig!"

End Sub
Eine Menge reden, aber nichts sagen können viele...
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste