VBA kopieren mit Variablen Anfangs- und Endbereich

[Arek]

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

[Steffl]

Hallo,

vielleicht so?

Code:

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

[Arek]

Hallo Stefan,

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)?

    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False


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?

[Steffl]

Hallo,

die erste Frage verstehe ich nicht. Bei der zweiten: Prinzipiell würde ich sagen: Ja.

[Arek]

Zu der ersten Frage:

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?

[Steffl]

Hallo,

ersetze diese Codezeile

Code:

.Range(.Cells(.Range("O1").Value, vntSpalten(lngSpalten)).Address, .Cells(.Range("R1").Value, vntSpalten(lngSpalten)).Address).Copy .Range("T2").Offset(, lngSpalten)

durch diese zwei

Code:

.Range(.Cells(.Range("O1").Value, vntSpalten(lngSpalten)).Address, .Cells(.Range("R1").Value, vntSpalten(lngSpalten)).Address).Copy
.Range("T2").Offset(, lngSpalten).PasteSpecial Paste:=xlPasteValues

[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.

Gruß
Arek

[Steffl]

Hallo,

vielleicht so?

Code:

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

[Arek]

Hi,



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? 

Gruß
Arek

[Arek]

Habe es über den Namens-Manager und Youtube hoffe ich geschafft.