VBA - Aufgezeichnetes Makro verbessern

[EasY]

Hi Leute,

in Sachen Makros stehe ich noch gaaaaaaaaanz am Anfang. Deshalb habe ich für mein Arbeitsblatt ein Makro mittels Rekorder aufgezeichnet. Es funktioniert auch total super - allerdings frage ich mich, ob man das nicht

1. optimieren und damit schlanker machen kann

2. das "durchrattern" durch die Tabellenblätter abschaffen kann. Das sieht ein wenig unprofessionell aus :)



Vielen Dank schon mal im Voraus


Beschreibung des Makros:
Es wird stumpf ein Bereich in 12 Tabellenblätter an die selbe Stelle innerhalb des Blatts kopiert. Dabei soll nur der Wert, nicht die Formatierung kopiert werden.

Was der Rekorder mir ausgespuckt hat:

Code:

Range("K5:P14").Select
   Selection.Copy
   Sheets("Januar").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Februar").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("März").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("April").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Mai").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Juni").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Juli").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("August").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("September").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Oktober").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("November").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Dezember").Select
   Range("AF6:AK15").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Sheets("Einstellungen").Select

[Käpt'n Blaubär]

Hallo,

da rattert gar nichts, weil Dein hier vorgestelltes Makro weder einen Anfang noch ein Ende hat.

gib vorne im Makro die Zeile    Application.ScreenUpdating = False
Und spätestens vor dem End Sub die Zeile    Application.ScreenUpdating = True
dazu, dann sollte, wenn ich Dich richtig verstanden habe, das "Durchrattern" schon mal
vorbei sein.
Über den Rest reden wir dann später.

[MisterBurns]

Hallo,

man kann in 99,9 % aller Fälle auf .Select und .Activate verzichten, so auch in deinem Makro.

Bei dir bietet sich eine Schleife an, die die Tabellenblätter durchläuft. Da ich deinen Dateiaufbau nicht kenne, also nicht weiß, wieviele Tabellenblätter sonst noch enthalten sind, geht es zB auf diesem Weg.

Code:

Dim i As Integer

Sheets("Einstellungen").Range("K5:P14").Copy
   
   For i = 2 To 13
       Sheets(i).Range("AF6:AK15").PasteSpecial Paste:=xlPasteValues
   Next
   
Application.CutCopyMode = False

Ich bin davon ausgegangen, dass die Werte aus dem Blatt "Einstellungen" kopiert werden und dass die Zielblätter (Jänner bis Dezember) die fortlaufenden Nummern 2 bis 13 haben. Falls dem nicht so ist, müsstest du das anpassen.

[EasY]

Hallo Käpt'n,

Verzeihung, du hast Recht. Den Start und das Ende habe ich nicht mitkopiert - sorry!
JAAA! Du hast mich richtig verstanden und JAAA! es funktioniert. Das Durchrattern ist nicht mehr da. Super, danke! 


Gibt es auch einen Befehl, dass er nach dem Beenden des Makros nicht mehr die kopierten Bereiche angewählt hat? Am liebsten wäre es mir, wenn das quasi unsichtbar abläuft.


Tut mir Leid, wenn ich in Sachen VBA nicht die richtigen Worte parat habe - ich bin, wie gesagt, erst am Anfang was das Programmieren angeht. Bislang habe ich eine Youtube-Videoreihe durchgeschaut :)



Gruß

[EasY]

Moin Berni,

klasse - das mit der For-Schleife habe ich tatsächlich auch schon Mal gehört und jetzt genau so übernommen. Das macht das ne ganze Ecke schlanker.


Du lagst absolut richtig - die Blätter 2-13 sind die, in die es kopiert werden soll. Und daran ändert sich auch in Zukunft nichts, von daher passt das super. Habe noch den Befehl vom Käpt'n davor bzw. danach eingebaut. Funktioniert Klasse

DANKE!

[EasY]

Vielleicht ist das jetzt aufgrund meiner Freudenausbrüche untergegangen.... eine Sahnehäubchen auf der Torte fehlt noch :)


Gibt es auch einen Befehl, dass er nach dem Beenden des Makros nicht mehr die kopierten Bereiche angewählt hat? Am liebsten wäre es mir, wenn das quasi unsichtbar abläuft.

[Steffl]

Auch Hallo,

Gibt es auch einen Befehl, dass er nach dem Beenden des Makros nicht mehr die kopierten Bereiche angewählt hat? Am liebsten wäre es mir, wenn das quasi unsichtbar abläuft.

vor dem End Sub einfügen

Code:

Application.CutCopyMode = False

[MisterBurns]

Gibt es auch einen Befehl, dass er nach dem Beenden des Makros nicht mehr die kopierten Bereiche angewählt hat?

Das ist der Teil mit dem Application.CutCopyMode = False, das beendet den Kopiermodus. Wenn du meinen Code komplett gelesen und kopiert hättest, hättest du das bemerkt.

Der Befehl vom Käpt'n verhindert das von dir angesprochene "Rattern", da die Aktionen am Bildschirm nicht mehr nacheinander angezeigt werden. Das passiert nur, wenn man mit .Select arbeitet.
In meinem Code kannst du das natürlich auch verwenden, ist aber unnötig, da beim Schleifendurchlauf auch keine Bildschirmaktion stattfindet. Ist quasi, wie wenn du Gürtel und Hosenträger verwendest.

[EasY]

Das ging flott. Ich glaube ich habe mich falsch ausgedrückt - sorry. Ja der Rahmen um das Kopierte ist nicht da. Der Rahmen in den einzelnen Blättern um das Eingefügte jedoch schon. Geht der noch mit einem Befehl weg? Oder muss ich das einzeln mit einem Select-Befehl umsetzen?


P.S.: Also in deiner Variante Bernie rattert er durch, wenn ich den Befehl vom Käpt'n nicht mit einbaue.

[MisterBurns]

Na gut, ein leichtes Flackern ist evtl zu erkennen. Aber egal, ist ja kein Fehler die Bildschirmupdates auszuschalten.

Um die Markierung in den Zielblättern aufzuheben, musst du tatsächlich in jedem Blatt eine andere Zelle auswählen. Pass den Code so an:

Code:

Sub Kopieren()
Dim i As Integer

Sheets("Einstellungen").Range("K5:P14").Copy
 
  For i = 2 To 13
      Sheets(i).Range("AF6:AK15").PasteSpecial Paste:=xlPasteValues
     Sheets(i).Range("A1").Select       'Hier die gewünschte markierte Zelle eintragen
  Next
 
Application.CutCopyMode = False
End Sub

Oder so geht's auch noch:

Code:

Sub Kopieren()
Dim i As Integer
   
   For i = 2 To 13
       Sheets(i).Range("AF6:AK15").Value = Sheets("Einstellungen").Range("K5:P14").Value

   Next
   
End Sub

Da flackert dann definitiv nichts mehr.