Makro optimieren - Kopieren und Einfügen von Zeilen

[hello123]

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

[hello123]

hat keiner einen Vorschlag? 

[maninweb]

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ß

[hello123]

Funktioniert - vielen Dank!