Hallo Rainer,,
hier ist mein Code.
Die Variable "monat" will ich im Code "Diagramm" weiter nutzen....
Option Explicit
Dim monat As Integer
Sub Zahlungen()
'
'Aktualisiert in der Zieldatei ausgewählte Datensätze aus einer "Veränderungsdatei"
Dim Veraend As String, sVer As Double
Dim monat As Integer
Dim monat1 As Integer, gesamt As Integer
gesamt = Columns(1).Find(what:="Gesamt", lookat:=xlWhole).Row
Veraend = Application.InputBox("Nr. eingeben: ", "Ein-/Auszahlungen Training")
monat = Application.InputBox("MonatsNr: ", "Ein-/Auszahlungen Training")
monat1 = (monat * 3) + 1
Cells(Cells(Rows.Count, monat * 3 + 1).End(xlUp).Row, monat * 3 + 1) = Format(Date, "DD.MM. ") & Veraend
Cells(Cells(Rows.Count, monat * 3 + 2).End(xlUp).Row + 1, monat * 3 + 2).Value = _
Application.WorksheetFunction.Sum(Range(Cells(5, monat * 3 + 2), Cells(gesamt - 1, monat * 3 + 2)))
Cells(Cells(Rows.Count, monat * 3 + 2).End(xlUp).Row, monat * 3 + 2).NumberFormat = ("#,##0.00 ")
Sheets("Zahlungen").Select
' Application.Calculation = xlCalculationManual
Dim rng As Range
Dim iRow As Integer
iRow = 3
Do Until IsEmpty(Cells(iRow, 1))
If Cells(iRow, 10) = Veraend And Cells(iRow, 8) <> "" Then
sVer = sVer + Cells(iRow, 7)
Set rng = Worksheets("Jahresabrechnung").Columns(1).Find( _
what:=Cells(iRow, 9), lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
If Cells(iRow, 7).Value + rng.Offset(0, monat1).Value > rng.Offset(0, monat1 - 1).Value And monat < 12 Then
rng.Offset(0, monat1 + 3).Value = Cells(iRow, 7).Value + rng.Offset(0, monat1).Value - rng.Offset(0, monat1 - 1).Value
rng.Offset(0, monat1).Value = rng.Offset(0, monat1 - 1)
Else
rng.Offset(0, monat1).Value = rng.Offset(0, monat1).Value + Cells(iRow, 7).Value
End If
If (rng.Offset(0, monat1 + 1).Value <> 0 Or rng.Offset(0, monat1 + 3) <> 0) And monat1 + 3 < 40 Then
rng.Offset(0, monat1).Font.ColorIndex = 46
End If
End If
End If
iRow = iRow + 1
Loop
' Übertragung des aktuellen Standes der Veränderungen in das Arbl
Sheets("Zahlungen").Select
Dim stand As String
ActiveSheet.Range("J" & Cells(Rows.Count, 10).End(xlUp).Row).Select
stand = Application.ActiveCell
Sheets("Jahresabrechnung").Select
Cells(Cells(Rows.Count, monat * 3 + 3).End(xlUp).Row, monat * 3 + 3) = sVer
Cells(Cells(Rows.Count, monat * 3 + 3).End(xlUp).Row, monat * 3 + 3).NumberFormat = ("#,##0.00 ")
Cells(4, monat1) = "Stand:" & stand
' Application.Calculation = xlCalculationAutomatic
Cells(50, monat1).Select
'Range("G" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
Call Diagramm
End Sub
Sub Diagramm()
Dim gesamt As Double, ende As Integer
Application.ActiveSheet.ChartObjects.Delete
gesamt = Columns(1).Find(what:="Gesamt", lookat:=xlWhole).Row
Cells(Cells(Rows.Count, monat * 3 + 1).End(xlUp).Row + 1, monat * 3 + 1) = "OFFEN"
Cells(Cells(Rows.Count, monat * 3 + 3).End(xlUp).Row + 1, monat * 3 + 3) = -Cells(gesamt, monat * 3 + 3)
ende = Cells(Rows.Count, monat * 3 + 1).End(xlUp).Row
Dim chrDiagramm As ChartObject
ActiveSheet.Shapes.AddChart.Select
ActiveSheet.ChartObjects(1).Top = Range("AQ183").Top
ActiveSheet.ChartObjects(1).Left = Range("AQ183").Left
ActiveChart.SetSourceData Source:=Union(Range("AK196:AK" & ende), Range("AM196:AM" & ende))
ActiveChart.ChartType = xlColumnStacked
ActiveChart.PlotBy = xlRows
'ActiveChart.PlotArea.Select
For Each chrDiagramm In ActiveSheet.ChartObjects
chrDiagramm.Width = 250
chrDiagramm.Height = 140
Next
Range("AQ180").Select
End Sub