Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1448to1452
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1448to1452
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code vereinfachen

Code vereinfachen
06.10.2015 01:16:03
Markus
Hallo,
ich habe da eine Aufzeichung.
kann man diesen Code vereinfachen,
Ich muss immer kopieren und die einfüge liste ist 300 Zeilen lang 
Sub Makro3()
' Makro3 Makro
Sheets("einspielen").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Einspielen").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("F4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("A5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("A6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("F6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("A7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("einspielen").Select
Range("F7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Es muss immer so kopieren ( bis Spalte D bei Etiketten)
A2( TB einfügen) in A2 (TB Etiketten)
F2(TB einfügen) in A1 (TB Etiketten)
A3(TB einfügen) in B2 (TB Etiketten)
F3(TB einfügen) in B1 (TB Etiketten)
A4(TB einfügen) in C2 (TB Etiketten)
F4(TB einfügen) in C1 (TB Etiketten)
A5(TB einfügen) in D2 (TB Etiketten)
F5(TB einfügen) in D1 (TB Etiketten)
A6(TB einfügen) in A4 (TB Etiketten)
F6(TB einfügen) in A3 (TB Etiketten)
A7(TB einfügen) in B4 (TB Etiketten)
F7(TB einfügen) in B3 (TB Etiketten)
A8(TB einfügen) in C4 (TB Etiketten)
F8(TB einfügen) in C3 (TB Etiketten)
usw...
Alles wären Zahlen
Besten Dank
Markus

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code vereinfachen
06.10.2015 02:07:18
Daniel
Hi
da du nur die Werte überträgst, kannst du das kopieren eines Wertes als Einzeiler schreiben:
Sheets("einspielen").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Etiketten").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
lässt sich verkürzen zu:
Sheets("Etiketten").Range("A2").value = Sheets("einspielen").Range("A2").value.
zusammenhängende Blöcke wie könnte man auch als ganzes kopieren und mit Transponieren einfügen:
Sheets("einspielen").Range("A2:A5").copy
Sheets("Etiketten").Range("A2").PasteSpecial xlpastevalues, Transpose:=true
Sheets("einspielen").Range("F2:F5").copy
Sheets("Etiketten").Range("A1").Pastespecial xlpastevalues, transpose:=true
Sheets("Einspielen").Range("A6:A9").copy
Sheets("Etiketten").Range("A4").pasteSpecial xlpastevalues, transpose:=true
Sheets("einspielen").Range("F6:F9").copy
Sheets("Etiketten").range("A3").Pastespecial xlpastevalues, Transpose:=true

Gruss Daniel

Anzeige
AW: Code vereinfachen
06.10.2015 02:59:53
Markus
Hallo Daniel,
wenn ich diesen Code nehme, wie muß ich da weiter machen?
Sheets("Etiketten").Range("A2").value = Sheets("einspielen").Range("A2").value.
Gru0 Markus

AW: Code vereinfachen
06.10.2015 06:00:53
Werner
Hallo Markus,
da verstehe ich jetzt deine Frage nicht ganz. Für den ersten "Kopiervorgang" hast du von Daniel ja folgende Codezeile:
Sheets("Etiketten").Range("A2").value = Sheets("einspielen").Range("A2").value
Für die weiteren "Kopiervorgänge" dann einfach diese Zeile kopieren, darunter einfügen und die Zellbezüge entsprechend anpassen, so lange bis du alles drin hast. Also dann:
Sheets("Etiketten").Range("F2").value = Sheets("einspielen").Range("A1").value
Sheets("Etiketten").Range("A3").value = Sheets("einspielen").Range("B2").value.
Gruß Werner
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige