Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1416to1420
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen per Makro nach unten kopieren

Zeilen per Makro nach unten kopieren
08.04.2015 21:24:43
Felix
Meine Ausgangstabelle ist der Bereich von A bis D. Ich möchte eine Tabelle rechts davon in G bis J erstellen, die dieselben Zeilen enthält. Zusätzlich sollen aber die Zeilen aus der Tabelle links entsprechend der Anzahl in Spalte D kopiert werden.
In der Spalte Copy gebe ich also an, wie of die jeweilige Zeile in der neuen Tabelle kopiert werden soll.
Gibt es dafür ein Makro?
https://www.herber.de/bbs/user/96957.xlsx
Vielen Dank schon mal für Eure Hilfe!

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen per Makro nach unten kopieren
09.04.2015 08:04:11
Werner
Hallo Felix,
diesen Code in das Code-Fenster des Tabellenblattes kopieren auf das sich der Code auswirken soll. Überwacht wird die Spalte D auf Eingaben.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim x As Long
Application.ScreenUpdating = False
If Target.Column = 4 And Not IsEmpty(Target) Then
If Cells(Target.Row, 1).Value = "" Or Cells(Target.Row, 2).Value = "" Or Cells(Target.Row, 3). _
Value = "" Then
Target = ""
Cells(Target.Row, 1).Select
MsgBox "Erst alle Datenfelder füllen."
Exit Sub
Else
If Not IsNumeric(Target) Then
MsgBox "Nur Eingabe von Zahlen zulässig."
Target = ""
Target.Select
Exit Sub
Else
i = Cells(Rows.Count, 7).End(xlUp).Row + 1
x = Target.Value
Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Copy
Cells(i, 7).Resize(x).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If
End If
End If
Application.ScreenUpdating = True
End Sub
Im Code wird die letzte belegte Zelle in Spalte G ermittelt und danach die Daten reinkopiert.
###Wichtig###
In der Datei die du hochgeladen hast, geht deine Tabelle der Spalten G:H bis zur Zeile 124. Zieh bitte deine Tabellenrahmen von 124 nach oben, so dass nur die belegten Zeilen in der Tabelle sind. Das ist ja gerade der Vorteil, wenn du einen Bereich als Tabelle formatiert hast, dass sich die Tabelle automatisch erweitert wenn weitere Daten eingegeben werden.
Wenn du das so lässt wie in deinem Beispiel dann würde der Code die kopierten Daten ab Zeile 125 einfügen.
Werner

Anzeige
AW: Zeilen per Makro nach unten kopieren
09.04.2015 08:09:44
Klaus
Hi Felix,
im Prinzip so:
Option Explicit
Sub CopyXMal()
Const ColCopy As Long = 4
Const ColFrom As Long = 1
Const ColTill As Long = 3
Const ColTo As Long = 7
Const RowStart As Long = 2
Dim RowEnd As Long
Dim RowEndTo As Long
Dim r As Range
With ActiveSheet
RowEnd = .Cells(.Rows.Count, ColCopy).End(xlUp).Row
For Each r In .Range(.Cells(RowStart, ColCopy), .Cells(RowEnd, ColCopy))
RowEndTo = .Cells(.Rows.Count, ColTo).End(xlUp).Row + 1
.Range(.Cells(r.Row, ColFrom), .Cells(r.Row, ColTill)).Copy
If r.Value > 0 Then
.Cells(RowEndTo, ColTo).Resize(r.Value, 1).PasteSpecial
Application.CutCopyMode = False
End If
Next r
End With
End Sub
Das funktioniert aber nur, wenn du die Bereiche nicht als seperate Tabellen deklarierst, wie du es in deiner Musterdatei getan hast.
Grüße,
Klaus M.vdT.

Anzeige
AW: Zeilen per Makro nach unten kopieren
09.04.2015 13:43:16
Felix
Langsam habe ich ein schlechtes Gewissen, dass mir hier immer so schnell geholfen wird, ich aber nichts außer eine "Tausend Dank!" zurückgeben kann.
Klappt beides hervorragend und hat mir mal wieder sehr viel Zeit gespart.

Danke für die Rückmeldung! owT.
09.04.2015 15:06:12
Klaus
.

AW: Zeilen per Makro nach unten kopieren
09.04.2015 17:53:40
Felix
Jetzt habe ich doch noch eine Anfängerfrage:
Wie muss ich das Makro (ich benutze derzeit das zweite: Sub CopyXMal()) ändern, damit nur die Zahlenformate und Zahlenwerte, nicht aber die anderen Zellformatierungen, wie z. B. die Zellfarbe, kopiert werden?

AW: Danke für Rückmeldung u. Antwort auf Frage
09.04.2015 20:40:38
Werner
Hallo Felix,
auch von mir noch ein Danke für die Rückmeldung. Und zu deiner Frage:
.Cells(RowEndTo, ColTo).Resize(r.Value, 1).PasteSpecial (xlPasteValues)
Gruß Werner

Anzeige
AW: Danke für Rückmeldung u. Antwort auf Frage
09.04.2015 21:12:42
Felix
Supercool! Jetzt macht meine Tabelle endlich, was sie soll. Vielen Dank für die wie immer sehr schnelle Hilfe.

324 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige