Flackern trotz ScreenUpdating = False
05.02.2007 19:56:47
Roland
ich habe wieder einmal eine Frage, bei der ihr mir sicher weiterhelfen könnt.
Mit dem Makro "FilterEinzel" (ist im untenstehenden Makro enthalten) filtre und markiere ich auf 12 Monatsblättern die Daten, die ich auf der Jahresansicht brauche.
Mit dem untenstehenden Makro hole ich nun alle Daten aus den Monatsblättern und Kopiere sie in die Jahresansicht.
Das Funktioniert alles soweit so gut. Nur habe ich ein Problem: Beim ausführen des Makros sieht man auf dem Bildschirm trotz Application.ScreenUpdating = False alle Monatsblätter durchlaufen und auch die Linienkorrektur am schluss.
Dieses Manko möchte ich gerne beheben. Was mache ich falsch oder kann man das Makro irgendwie ändern oder etwas einblenden so lange die Berechnung läuft?
Besten Dank für eure Hilfe.
Gruss
Roland
Sub EinzelblattFüllen()
Application.ScreenUpdating = False
Filter.FilterEinzel ' inkl.Filter zurücksetzen
Worksheets("Einzel").Select
ActiveSheet.Unprotect myPwd
Worksheets(1).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F6").Select
ActiveSheet.Paste
Worksheets(2).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F7").Select
ActiveSheet.Paste
Worksheets(3).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F8").Select
ActiveSheet.Paste
Worksheets(4).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F9").Select
ActiveSheet.Paste
Worksheets(5).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F10").Select
ActiveSheet.Paste
Worksheets(6).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F11").Select
ActiveSheet.Paste
Worksheets(7).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F12").Select
ActiveSheet.Paste
Worksheets(8).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F13").Select
ActiveSheet.Paste
Worksheets(9).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F14").Select
ActiveSheet.Paste
Worksheets(10).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F15").Select
ActiveSheet.Paste
Worksheets(11).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F16").Select
ActiveSheet.Paste
Worksheets(12).Select
Selection.Copy
Worksheets("Einzel").Select
Range("F17").Select
ActiveSheet.Paste
Filter.FilterAufheben
Worksheets("Einzel").Select
'Linien richtig setzen
Range("F6:BO17").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
[K22].Select
ActiveWindow.SmallScroll Down:=-24
ActiveSheet.Protect myPwd
Application.ScreenUpdating = True
End Sub