Public
MAohne
As
String
Sub
neue_KW_Ausschuss()
Dim
tool
As
String
Ausschuss = ActiveSheet.Name
ziele = ActiveWorkbook.Name
spalte = InputBox(
"In welcher Spalte sollen die Meldungen eingetragen werden?"
,
"Dateneingabe"
, ActiveCell.Column)
If
spalte =
""
Then
Exit
Sub
spalte =
CInt
(spalte)
Anzahl = Workbooks.Count
Select
Case
Anzahl
Case
1: MsgBox (
"Es wurden keine weitere Excelliste gefunden"
)
Exit
Sub
Case
2: Daten = InputBox(
"Nr 1: "
& Left(Workbooks(1).Name, 36) & vbCrLf &
"Nr 2: "
& Left(Workbooks(2).Name, 36),
"Angabe Excelmappen mit Ausschussdaten?"
,
"1"
)
Case
3: Daten = InputBox(
"Nr 1: "
& Left(Workbooks(1).Name, 36) & vbCrLf &
"Nr 2: "
& Left(Workbooks(2).Name, 36) & vbCrLf &
"Nr 3: "
& Left(Workbooks(3).Name, 36),
"Angabe Excelmappen mit Ausschussdaten?"
,
"1"
)
Case
4: Daten = InputBox(
"Nr 1: "
& Left(Workbooks(1).Name, 36) & vbCrLf &
"Nr 2: "
& Left(Workbooks(2).Name, 36) & vbCrLf &
"Nr 3: "
& Left(Workbooks(3).Name, 36) & vbCrLf &
"Nr 4: "
& Left(Workbooks(4).Name, 36),
"Angabe Excelmappen mit Ausschussdaten"
,
"1"
)
Case
Else
MsgBox (
"Es sind zu viele Exceldateien offen. Bitte reduzieren Sie die Anzahl auf maximal 4."
& vbCrLf &
"Vielen Dank."
)
Exit
Sub
End
Select
Application.ScreenUpdating =
False
If
Daten =
""
Then
Exit
Sub
Daten = Workbooks(
CInt
(Daten)).Name
Workbooks(ziele).Activate
Anzahl = 0
For
zeile = 3
To
Worksheets(Ausschuss).Cells(100,
"B"
).
End
(xlUp).Row
Step
1
If
Worksheets(Ausschuss).Cells(zeile,
"A"
).Value =
"x"
Then
MA = Worksheets(Ausschuss).Cells(zeile,
"B"
).Value
Workbooks(Daten).Activate
For
lineD = 3
To
Worksheets(3).Cells(100,
"B"
).
End
(xlUp).Row
Step
1
If
Worksheets(3).Cells(lineD,
"B"
).Value = MA
Then
Anzahl = Worksheets(3).Cells(lineD,
"C"
).Value
Exit
For
End
If
Next
lineD
If
lineD = Worksheets(3).Cells(100,
"B"
).
End
(xlUp).Row
Then
Anzahl =
"nicht gefunden"
Workbooks(ziele).Activate
Worksheets(Ausschuss).Cells(zeile, spalte).Value = Anzahl
Anzahl =
""
End
If
Next
zeile
End
Sub