Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: hello123 am März 07, 2018, 09:35:50 Vormittag

Titel: Makro optimieren - Kopieren und Einfügen von Zeilen
Beitrag von: hello123 am März 07, 2018, 09:35:50 Vormittag

Hallo zusammen,

ich habe wieder eine Frage. Ich habe das untenstehende Makro aufgezeichnet und einem Button zugeordnet. Das Makro läuft ziemlich lange. Gibt es eine Möglichkeit, das Ganze etwas schneller zu gestalten?
Ich möchte, dass die Werte der Zeilen in die nächste Zeile kopiert werden (nicht die Formeln).

Code: [Auswählen]

Sub aktuelleWoche_inVorwoche_kopieren()
'
' aktuelleWoche_inVorwoche_kopieren Makro
'

'
    Range("H56:K56").Select
    Selection.Copy
    Range("H57").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H58:K58").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H59").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H60:K60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H61").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H62:K62").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H64:K64").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H65").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H66:K66").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H67").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H68:K68").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=12
    Range("H72:K72").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H73").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H74:K74").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H75").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H76:K76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H77").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H78:K78").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H79").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H80:K80").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H81").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H82:K82").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H83").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H84:K84").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H85").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=12
    Range("H88:K88").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H89").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H90:K90").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H91").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H92:K92").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H93").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H94:K94").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H95").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H96:K96").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H97").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H98:K98").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H99").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H100:K100").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H101").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Kann mir jemand weiterhelfen?

Vielen Dank vorab!

Grüße

Titel: Antw: Makro optimieren - Kopieren und Einfügen von Zeilen
Beitrag von: hello123 am März 08, 2018, 14:34:20 Nachmittag

hat keiner einen Vorschlag?  :-[

Titel: Antw: Makro optimieren - Kopieren und Einfügen von Zeilen
Beitrag von: maninweb am März 09, 2018, 11:06:07 Vormittag

Hallo,

Du brauchst keine Selects, anbei ein Beispiel welches Du entsprechend ergänzen muss, ungetestet...

Code: Visual Basic

1. Sub aktuelleWoche_inVorwoche_kopieren()
2.  
3.   Application.Calculation = xlCalculationManual
4.  
5.   Range("H57:K57").Value = Range("H56:K56").Value
6.   Range("H59:K59").Value = Range("H58:K58").Value
7.  
8. ' :
9. ' :
10. ' :
11.  
12.   Application.Calculation = xlCalculationAutomatic
13.  
14. End Sub

Gruß

Titel: Antw: Makro optimieren - Kopieren und Einfügen von Zeilen
Beitrag von: hello123 am März 09, 2018, 13:07:29 Nachmittag

Funktioniert - vielen Dank!