Probleme mit Application.ScreenUpdating = False
29.01.2019 13:08:25
Sebastian
bei nachfolgenden Code werden aus bestimmten Arbeitsblättern Bereiche in das Arbeitsblatt "Zusammenfassung" kopiert, dort ein Filter drübergelegt und dann diese Daten wiederum in das Blatt "offene Aufträge" kopiert. Hat immer geklappt, nun läuft das Makro ohne Fehlermeldung durch, kopiert aber nix. Entferne ich Application.ScreenUpdating = False, läuft das ganze auch wenigstens bis zum Schritt kopieren in Blatt "Zusammenfassung". Die folgenden Schritte, den Filter drüberlegen und die gefilterten Daten in das Blatt "offene Aufträge" kopieren klappt wieder nicht. Auch hier alles ohne Fehlermeldung. Den gleichen Code habe ich in einer anderen Arbeitsmappe, wo er ohne Problem durchläuft. Einer eine Idee woran es liegen kann?
Sub Makro2()
' offene Aufträge
Dim shMain As Worksheet
Dim Sh As Worksheet
Dim i As Integer
Set shMain = Sheets("Zusammenfassung")
Set shMain2 = Sheets("offene Aufträge")
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
ActiveWorkbook.Sheets(i).Unprotect Password:="xxx"
Next
Sheets("Zusammenfassung").Select
Range("A5:i1000").Select
Selection.ClearContents
For Each Sh In ThisWorkbook.Worksheets
'Festlegung welche Tabellenblätter kopiert werden sollen und dann
If Sh.Name "Zusammenfassung" And Sh.Name "offene Aufträge" And Sh.Name " _
_Auswertung" And Sh.Name "Daten" Then
'welcher Bereich soll kopiert werden & mit Ergänzung nur den Bereich im gewähltem Bereich zu _
kopieren mit dem letzten Eintrag in Spalte 1 des gewählten Bereichs (in diesen Fall Spalte C)
Sh.Range("a5:i" & Sh.Cells(Sh.Rows.Count, 1) _
.End(xlUp).Row).Copy
'Wohin kopieren
shMain.Cells(shMain.Cells(shMain.Rows.Count, 2) _
.End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
shMain2.Select
Range("a5:i300").Select
Selection.ClearContents
shMain.Range("a4:j1000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=shMain2.Range("i1:i2"), CopyToRange:=shMain2.Range("a4:j4"), Unique:=False
Range("A4:j4").Select
Selection.AutoFilter
shMain2.Select
Range("A4:j4").Select
Selection.AutoFilter
For i = 1 To Sheets.Count
ActiveWorkbook.Sheets(i).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:="xxx"
Next
End Sub
MfG Sebastian