Option Explicit
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim wks3 As Worksheet
Sub Eintragen1()
Set wks1 = Worksheets("Analyse1")
Set wks2 = Worksheets("Daten")
Set wks3 = Worksheets("K-Liste")
Dim Zeile As Integer
Dim Zeile2 As Integer
Dim Zeile3 As Integer
Dim AnzahlG As Integer
Dim vorhanden As Integer
Dim Stelle As Integer
Dim i As Integer
Zeile = 20
Zeile2 = 8
Zeile3 = 8
AnzahlG = 0
vorhanden = 0
Stelle = 0
Worksheets("Analyse1").Cells.Clear
Do
If (wks2.Cells(Zeile, 11) <> "") Then
If (wks2.Cells(Zeile, 8) = "OS") Then
vorhanden = 0
For i = 0 To AnzahlG
If wks1.Cells((3 + i), 1) = wks2.Cells(Zeile, 7) Then
vorhanden = 1
Stelle = 3 + i
End If
Next i
If vorhanden = 0 Then
wks2.Cells(Zeile, 7).Copy
wks1.Cells((3 + AnzahlG), 1).PasteSpecial Paste:=xlValues
wks1.Cells((3 + AnzahlG), 2) = wks1.Cells((3 + AnzahlG), 2) + wks2.Cells(Zeile, 26)
wks1.Cells((3 + AnzahlG), 3) = wks1.Cells((3 + AnzahlG), 3) + wks2.Cells(Zeile, 27)
wks1.Cells((3 + AnzahlG), 4) = wks1.Cells((3 + AnzahlG), 4) + wks2.Cells(Zeile, 28)
wks1.Cells((3 + AnzahlG), 5) = wks1.Cells((3 + AnzahlG), 5) + wks2.Cells(Zeile, 29)
wks1.Cells((3 + AnzahlG), 6) = wks1.Cells((3 + AnzahlG), 6) + wks2.Cells(Zeile, 30)
wks1.Cells((3 + AnzahlG), 7) = wks1.Cells((3 + AnzahlG), 7) + wks2.Cells(Zeile, 31)
'wks1.Cells((3 + AnzahlG), 8) = wks2.Cells(Zeile, 11)
AnzahlG = AnzahlG + 1
Else
Zeile2 = 8
Do
If (wks1.Cells(Stelle, Zeile2) = "") Then
'wks1.Cells(Stelle, Zeile2) = wks2.Cells(Zeile, 11)
wks1.Cells(Stelle, 2) = wks1.Cells(Stelle, 2) + wks2.Cells(Zeile, 26)
wks1.Cells(Stelle, 3) = wks1.Cells(Stelle, 3) + wks2.Cells(Zeile, 27)
wks1.Cells(Stelle, 4) = wks1.Cells(Stelle, 4) + wks2.Cells(Zeile, 28)
wks1.Cells(Stelle, 5) = wks1.Cells(Stelle, 5) + wks2.Cells(Zeile, 29)
wks1.Cells(Stelle, 6) = wks1.Cells(Stelle, 6) + wks2.Cells(Zeile, 30)
wks1.Cells(Stelle, 7) = wks1.Cells(Stelle, 7) + wks2.Cells(Zeile, 31)
Exit Do
Else
Zeile2 = Zeile2 + 1
End If
Loop
End If
Zeile = Zeile + 1
Else
Zeile = Zeile + 1
End If
Else
Exit Do
End If
Loop
Zeile = 20
Zeile2 = 2
Do
If (wks3.Cells(Zeile2, 1) <> "") Then
Zeile = 20
Do
If (wks2.Cells(Zeile, 7) = wks3.Cells(Zeile2, 1) And wks2.Cells(Zeile, 8) <> "OS") Then
vorhanden = 0
For i = 0 To AnzahlG
If wks1.Cells((3 + i), 1) = wks3.Cells(Zeile2, 1) Then
vorhanden = 1
Stelle = 3 + i
End If
Next i
If (vorhanden = 0) Then
wks3.Cells(Zeile2, 1).Copy
wks1.Cells((3 + AnzahlG), 1).PasteSpecial Paste:=xlValues
wks1.Cells((3 + AnzahlG), 2) = wks1.Cells((3 + AnzahlG), 2) + wks2.Cells(Zeile, 26)
wks1.Cells((3 + AnzahlG), 3) = wks1.Cells((3 + AnzahlG), 3) + wks2.Cells(Zeile, 27)
wks1.Cells((3 + AnzahlG), 4) = wks1.Cells((3 + AnzahlG), 4) + wks2.Cells(Zeile, 28)
wks1.Cells((3 + AnzahlG), 5) = wks1.Cells((3 + AnzahlG), 5) + wks2.Cells(Zeile, 29)
wks1.Cells((3 + AnzahlG), 6) = wks1.Cells((3 + AnzahlG), 6) + wks2.Cells(Zeile, 30)
wks1.Cells((3 + AnzahlG), 7) = wks1.Cells((3 + AnzahlG), 7) + wks2.Cells(Zeile, 31)
'wks1.Cells((3 + AnzahlG), 8) = wks2.Cells(Zeile, 11)
AnzahlG = AnzahlG + 1
Else
Zeile3 = 8
Do
If (wks1.Cells(Stelle, Zeile3) = "") Then
'wks1.Cells(Stelle, Zeile3) = wks2.Cells(Zeile, 11)
wks1.Cells(Stelle, 2) = wks1.Cells(Stelle, 2) + wks2.Cells(Zeile, 26)
wks1.Cells(Stelle, 3) = wks1.Cells(Stelle, 3) + wks2.Cells(Zeile, 27)
wks1.Cells(Stelle, 4) = wks1.Cells(Stelle, 4) + wks2.Cells(Zeile, 28)
wks1.Cells(Stelle, 5) = wks1.Cells(Stelle, 5) + wks2.Cells(Zeile, 29)
wks1.Cells(Stelle, 6) = wks1.Cells(Stelle, 6) + wks2.Cells(Zeile, 30)
wks1.Cells(Stelle, 7) = wks1.Cells(Stelle, 7) + wks2.Cells(Zeile, 31)
Exit Do
Else
Zeile3 = Zeile3 + 1
End If
Loop
End If
End If
Zeile = Zeile + 1
If (wks2.Cells(Zeile, 11) = "") Then
Exit Do
End If
Loop
Zeile2 = Zeile2 + 1
If (wks3.Cells(Zeile2, 1) = "") Then
Exit Do
End If
Else
Exit Do
End If
Loop
wks1.Cells(1, 1) = "K-Paket-Nummer"
wks1.Cells(1, 2) = "Plan - INV1"
wks1.Cells(1, 3) = "Ist - INV1"
wks1.Cells(1, 4) = "Obligo - INV1"
wks1.Cells(1, 5) = "Verfügt - INV1"
wks1.Cells(1, 6) = "AuftrRestPlan - INV1"
wks1.Cells(1, 7) = "Verfügt* - INV1"
wks1.Cells(2, 1) = "Gesamtsumme"
Worksheets("Analyse1").Cells.Rows.AutoFit
Worksheets("Analyse1").Cells.Columns.AutoFit
wks1.Cells(2, 2) = WorksheetFunction.Sum(Range(wks1.Cells(3, 2), wks1.Cells(3 + AnzahlG, 2)))
wks1.Cells(2, 3) = WorksheetFunction.Sum(Range(wks1.Cells(3, 3), wks1.Cells(3 + AnzahlG, 3)))
wks1.Cells(2, 4) = WorksheetFunction.Sum(Range(wks1.Cells(3, 4), wks1.Cells(3 + AnzahlG, 4)))
wks1.Cells(2, 5) = WorksheetFunction.Sum(Range(wks1.Cells(3, 5), wks1.Cells(3 + AnzahlG, 5)))
wks1.Cells(2, 6) = WorksheetFunction.Sum(Range(wks1.Cells(3, 6), wks1.Cells(3 + AnzahlG, 6)))
wks1.Cells(2, 7) = WorksheetFunction.Sum(Range(wks1.Cells(3, 7), wks1.Cells(3 + AnzahlG, 7)))
wks1.Range(wks1.Cells(3, 1), wks1.Cells(2 + AnzahlG, 7)).Sort Key1:=wks1.Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
wks1.Range("A1:G1").AutoFilter
wks1.Range(wks1.Cells(1, 1), wks1.Cells(2 + AnzahlG, 7)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub