18.10.2019, 14:53 (Dieser Beitrag wurde zuletzt bearbeitet: 19.10.2019, 12:33 von Glausius.)
Hallo ein Anfänger braucht Hilfe, ich habe eine Tabelle A:K. In Zelle O1 und P1 steht jeweils ein gewünschter Anfangswert (Variabel) und ein Endwert (Variabel) z.B. 10 in O1, 20 in P1. Der Bereich, der kopiert werden soll, wird anhand der Werte in O1 und P1 definiert. In A1 bis K1 stehen verschiedene Überschriften die sich auch Mal ändern können. Das Makro soll jetzt die Zellen A10 (Wert in O1) bis A20 (Wert in P1) kopieren nach AA1. Zusätzlich soll das Kopieren auch für die Spalten D, F und G passieren, gerne mit der aktuellen Überschrift (Es würde ein Beispiel reichen für A und D, denn Rest müsste ich dann hinbekommen). Wenn es möglich ist, sollen die kopierten Zellen, ohne leere Spalten nebeneinander erscheinen also A1 nach AA1 und runter, D nach AB1 usw., wobei in AA1 die Überschrift von A1 erscheint, in AB1 die von D usw. Wenn in AA1 die Überschrift steht sollen die Werte direkt in AA2 anfangen usw. Kann mir jemand helfen? Danke
Sub prcArek()
Dim vntSpalten As Variant
Dim lngSpalten As Long
vntSpalten = Array(1, 4, 6, 7)
With Worksheets("Tabelle1")
For lngSpalten = 0 To UBound(vntSpalten)
.Range(.Cells(.Range("O1").Value, vntSpalten(lngSpalten)).Address, .Cells(.Range("p1").Value, vntSpalten(lngSpalten)).Address).Copy .Range("AA1").Offset(, lngSpalten)
Next lngSpalten
End With
End Sub
danke, hat mich schon weitergebracht.
Habe ein wenig angepasst:
Sub prcArek()
Dim vntSpalten As Variant
Dim lngSpalten As Long
' Löscht die Spalten T bis W
Columns("T:W").Select
Selection.ClearContents
' Kopiert die Überschriften von A1, D1 usw. nach T1, U1 usw.
Range("A1,D1,F1,G1").Select
Selection.Copy
Range("T1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Kopiert die gewünschten Werte von Spalten A, D, F, G anhand der Werte in O1 (Startwert) und P1 (Endwert) nach R2
vntSpalten = Array(1, 4, 6, 7)
With Worksheets("tabelle1")
For lngSpalten = 0 To UBound(vntSpalten)
.Range(.Cells(.Range("O1").Value, vntSpalten(lngSpalten)).Address, .Cells(.Range("R1").Value, vntSpalten(lngSpalten)).Address).Copy .Range("T2").Offset(, lngSpalten)
Next lngSpalten
End With
End Sub
Wie kann ich das berücksichtigen in dem Makro aufbau (Soll Werte und Format übernehmen beim kopieren: mit Rekord aufgezeichnet)?
Eine zweite Frage, die Daten dienen um ein Diagramm zu füttern (Später vielleicht noch mehr Diagramme). Bei Variablen (in Zellen O1 und R1) die den zu kopierenden Bereiche 5 bis 10 festlegt ergibt das ja einen kopierten Bereich von R1 (Überschricht) bis W7. Kann ich dem Diagramm miteilen dass die Bereiche sich erweitert oder verkürzt haben die jetzt zu berücksichtigen sind?
Die Daten werden aus verschiedenen Tabellen in einer Tabelle zusammen gefasst. Aus den gesammelten Daten (ein Tabellen Blatt) möchte ich später einige Diagramme erstellen lassen. Deswegen die Möglichkeit der Variablen, das ich bestimmte Bereiche je nach Notwendigkeit auf eine neue stelle kopieren kann, wo die Daten dann für die Diagramme bereitliegen.
Die Zellen benutzen teilweise unterschiedliche "Zellen Formatierungen" über die Funktion (Zelle auswählen, Rechtsklick, Zelle formatieren, Benutzerdefiniert). Wenn ich manuell kopiere kann ich rechts unten in dem Menü auswählen "Werte und Zahlenformat" und damit werden die Benutzten Formate mit übernommen. Ich hoffe das ist verständlicher?
20.10.2019, 04:36 (Dieser Beitrag wurde zuletzt bearbeitet: 20.10.2019, 04:36 von Arek.)
Hallo Stefan,
danke für deine Informationen und Hilfe,
leider werden die Formatierungen nicht mit kopiert. Habe in Anhang eine test sheet eingefügt, wobei die Formatierungen nicht dem Original entsprechen. Habe einfach irgendwelche zum testen ausgewählt.
Sub prcArek_2()
Dim vntSpalten As Variant
Dim lngSpalten As Long
' Löscht die Spalten T bis W
Columns("T:W").ClearContents
' Kopiert die Überschriften von A1, D1 usw. nach T1, U1 usw.
Range("A1,D1,F1,G1").Copy
Range("T1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Kopiert die gewünchten Werte von Spalten A, D, F, G anhand der Werte in O1 (Startwert) und P1 (Endwert) nach T2
vntSpalten = Array(1, 4, 6, 7)
With Worksheets("tabelle1")
For lngSpalten = 0 To UBound(vntSpalten)
.Range(.Cells(.Range("O1").Value, vntSpalten(lngSpalten)).Address, .Cells(.Range("R1").Value, vntSpalten(lngSpalten)).Address).Copy
.Range("T2").Offset(, lngSpalten).PasteSpecial Paste:=xlPasteFormats
.Range("T2").Offset(, lngSpalten).PasteSpecial Paste:=xlPasteValues
Next lngSpalten
End With
End Sub
Jetzt bräuchte ich noch Hilfe bei dem Diagramm dass das Diagramm Variabel agiert wenn es mehr oder weniger Werte werden. Aktuell steht ja der Bereich im Diagramm fest wo Anfang und Ende des Datenbereichs ist.
Hast du dafür eine Idee?
