Sub Upload_Risk(Allfile As Workbook, PRJFile As Workbook)
Dim MaxLine As Integer
Dim MaxFillLine As Integer
Dim FirstEmptyLine As Integer
Dim NewLine As Integer
Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count, 6).End(xlUp).Row, Rows.Count)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Allfile.Activate
Sheets("INT").Select
FirstEmptyLine = 1
While Cells(FirstEmptyLine, "H").Text <> ""
FirstEmptyLine = FirstEmptyLine + 1
Wend
PRJFile.Activate
Sheets("RISKS").Select
MaxLine = Cells(Rows.Count, "B").End(xlUp).Row
If MaxLine < 1 Then
MsgBox ("There is no Risk in PRJ work file " & PRJFile.Name)
Exit Sub
End If
PRJFile.Activate
Sheets("RISKS").Select
Range("A7:P" & lngLetzte).Copy
Allfile.Activate
Range("C" & FirstEmptyLine).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NewLine = FirstEmptyLine
While Cells(NewLine, "C").Text <> ""
NewLine = NewLine + 1
HIER FANGEN DIE PROBLEME AN
Dim Reihe As Integer
Reihe = NewLine
With ActiveWorkbook.Worksheets("INT")
Do Until .Cells(Reihe, "H") = vbNullString
If .Cells(Reihe, "H") <> "" Then
.Cells(Reihe, "A") = PRJFile.Name
End If
Reihe = Reihe + 1
Loop
End With
Wend
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub