AW: Werte kopieren und in Tab2 einfügen (transponieren)
06.02.2026 11:00:51
daniel
Hi
kleiner Tip, wenn du mit dem Recorder arbeitest:
der Code, den der Recorder aufzeichnet, zeichnet auch viel unnötiges (z.B. deine Scrollbewegungen im Tabellenblatt) und umständlich auf.
dh aufgezeichneter Code sollte immer erstmal überarbeitet werden, dann wird er kürzer und übersichtlicher, und man sieht ggf schneller, wo man noch was ändern kann.
hierbei gelten zwei einfache Regeln:
1. alle Scrollbewegungen im Fenster löschen (ActiveWindow.LargeScroll = ).
das brauchst du als Anwender, um an die richtige Stelle im Blatt zu kommen, ein Makro braucht das nicht, das kann auch Zellen bearbeiten, die außerhalb des sichtbaren Bereichs liegen.
2. alle .Select und .Selection zusammenfassen.
aus
Range(...).Select
Selection.Copy
wird
Range(...).Select
der Recorder zeichnet so auf, weil wir zuerst den Zellbereich auswählen und dann den Befehl dazu anklicken und diesen auf die Auswahl (Selection) anwenden.
in VBA benötigt man das nicht, hier kann man den Befehl direkt an den Zellbereich anhängen, ohne in vorher zu selektieren.
3. sollte man alles übrerflüssige löschen.
dh wenn du erst die Zellen A1, C1, D1 selektierst und dann direkt danach A1, C1;' D1, F1, ist der erste Schritt unnötig.
4. wenn man mit mehreren Tabellenblättern arbeitet, solllte man vor Range und Cells immer das Tabellenblatt angeben, dann läuft das Makro, egal welches Blatt gerade aktiv ist und man muss die Blätter nicht wechseln.
dein makro sieht dann so aus:
Sub Copy_Artikel_Summe()
' Copy_Artikel Makro
Sheets("Tabelle1").Range("N10,P10,R10,T10,V10,X10,Z10,AB10,AD10").Copy
Sheets("Tabelle2").Range("B6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=alse, Transpose:=True
Sheets("Tabelle1").Range("M10,O10,Q10,S10,U10,W10,Y10,AA10,AC10").Copy
Sheets("Tabelle2").Range("C6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Sheets("Tabelle2").Columns("C:C").EntireColumn.AutoFit
End Sub
so solltest du alle deine Aufzeichnungen überarbeiten
da lässt sich dann auch einfacher die Anpassung einarbeiten.
ich würde her von der untersten Zeile nach oben springen bis zur letzen befüllten Zeile (Ende + Pfeil hoch) dann bist du in der letzten Zeile
hier kann man dann die Schittmenge aus dieser Zeile mit den Spalten bilden und diese kopieren
damit die Programmzeilen nicht so lang werden, packe ich die Zellbereiche mit den Spalten in Variablen:
dim rngKo as range
dim rngAN as range
dim rngLetzteZeile as Range
set rngKosten = Sheets("Tabelle1").Range("M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA,AC:AC")
set rngArtNr = Sheets("Tabelle1").Range("N:N,P:P:R:R,S:S,V:V,X:X,Z:Z,AB:AB,AD:AD")
set rngLetzteZeile = Sheets("Tabelle1").Cells(Rows.count, "N").End(xlup).EntireRow
Intersect(rngLetzteZeile, rngArtNr).Copy
Sheets("Tabelle2").Range("B6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=alse, Transpose:=True
Intersect(rngLetzteZeile, rngKosten).Copy
Sheets("Tabelle2").Range("C6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=alse, Transpose:=True
Gruß Daniel