Hallo
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.
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).Select
LastRow = Range("E65536").End(xlUp).Row
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