Option
Explicit
Sub
ZieheTeammitglieder()
On
Error
GoTo
cleanUp
Dim
wkbMain
As
Workbook, wkbDaten
As
Workbook
Set
wkbMain = ThisWorkbook
Set
wkbDaten = Application.Workbooks.Open(Filename:=
"O:\WFM\02 Abwesenheiten\08 Actuals\2017\T_Report Stammdaten_2017.xlsm"
)
Dim
Zeile
As
Long
Dim
ZeileMax
As
Long
Dim
n
As
Long
Dim
v
As
Variant
Dim
i
As
Integer
v = Application.ScreenUpdating
Application.ScreenUpdating =
False
With
wkbMain.Worksheets(
"MA Daten"
)
ZeileMax = .UsedRange.Rows.Count
n = 1
For
Zeile = 2
To
ZeileMax
If
.Cells(Zeile, 5).Value =
"T_TL XXX XXX"
Then
For
i = 1
To
10
wkbMain.Worksheets(
"Rohdaten Team"
).Cells(n, 1).Value = .Cells(n, 1).Value
Next
i
n = n + 1
End
If
Next
Zeile
End
With
Application.ScreenUpdating = v
On
Error
GoTo
0
cleanUp:
If
Err.Number <> 0
Then
MsgBox
"Es ist leider ein Fehler aufgetreten."
& vbCrLf & _
"Fehlernummer: "
& Err.Number & vbCrLf & _
"Fehlerbeschreibung: "
& Err.Description, vbExclamation
End
If
If
Not
wkbMain
Is
Nothing
Then
Set
wkbMain =
Nothing
If
Not
wkbDaten
Is
Nothing
Then
Set
wkbDaten =
Nothing
End
Sub