Bitte um Hilfe bei Code Optimierung
31.07.2014 11:46:02
Olaf
Als VBA-Anfänger brauche ich Eure Hilfe.Beiliegendes Macro kopiert Inhalte aus einer Mastertabelle auf ein neues Sheet, wo dann die Mehrheit der Zeilen wieder versteckt wird. Es funktioniert, aber leider ziemlich langsam :-/, da ca. 2000 Zeilen durchforstet werden müssen. Bin für jede Hilfe dankbar, die zur Beschleunigung beitragen. (insbesondere eine bessere Variante für die For-Schleife)Danke im Voraus!
Fred
Sub Staffing()
Dim wks As Worksheet
Dim WSheetC As String
Dim WSheetP As String
Application.DisplayAlerts = False
WSheetP = "Staffing"
WSheetC = "Vorhaben"
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = WSheetP Then
Sheets(WSheetP).Delete
End If
Next
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = WSheetP
Application.DisplayAlerts = True
Sheets(WSheetC).SelectLastRow = Range("E65536").End(xlUp).Row
'MsgBox "Letzte Zeile ist Nr. " & LastRow
Sheets(WSheetC).Range("A1:K" & LastRow).Select
Sheets(WSheetC).Range("A1:K" & LastRow).Copy
Sheets(WSheetP).Cells(1, 1).PasteSpecial xlPasteAll
Sheets(WSheetC).Range("AB1:AB" & LastRow).Copy
Sheets(WSheetP).Range("L1:L" & LastRow).Insert
Application.ScreenUpdating = False
For i = 17 To LastRow
If Sheets(WSheetP).Range("E" & i) = "Status Staffing" Or Sheets(WSheetP).Range("E" & i) = " _
Mitarbeiter Feasibility" Then
Sheets(WSheetP).Rows(i).Hidden = False
Else
Sheets(WSheetP).Rows(i).Hidden = True
End If
Next
Sheets(WSheetP).Rows("1:15").Hidden = True
Sheets(WSheetP).Rows("16").Hidden = False
Columns("D:D").EntireColumn.Hidden = True
Columns("E:E").EntireColumn.Hidden = True
Sheets(WSheetP).Range("A:A").ColumnWidth = "50"
Sheets(WSheetP).Range("F:K").ColumnWidth = "15"
Application.ScreenUpdating = True
End Sub