Code vereinfachen

Bild

Betrifft: Code vereinfachen
von: Markus
Geschrieben am: 06.10.2015 01:16:03

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

Bild

Betrifft: AW: Code vereinfachen
von: Daniel
Geschrieben am: 06.10.2015 02:07:18
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

Bild

Betrifft: AW: Code vereinfachen
von: Markus
Geschrieben am: 06.10.2015 02:59:53
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

Bild

Betrifft: AW: Code vereinfachen
von: Werner
Geschrieben am: 06.10.2015 06:00:53
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Code vereinfachen"