AW: Ich hab zwar schon...
08.05.2008 16:04:00
Jörg
Hier mal die Gesamtansicht.
Aber wie gesagt, das einzige Problem liegt im allerletzten Teil.
Sub Monatsübersicht()
Application.ScreenUpdating = False
Dim Datum As Date
Monat = Application.InputBox("Bitte nächsten einzufügenden Monat (MM) eingeben:")
Jahr = Application.InputBox("Bitte nächsten einzufügenden Jahr (JJ) eingeben:")
ThisWorkbook.Activate
Path = ThisWorkbook.Path
For i = 2 To 1000000
If Cells(12, i) = "Durchschnittsbon" Then
If Cells(12, i + 1) = "Betrag in T EUR" Then GoTo nächstesi
If Cells(12, i + 1) = "Betrag in TEUR" Then GoTo nächstesi
If Cells(12, i + 1) = "Betrag in EUR" Then GoTo nächstesi
If Cells(12, i + 1) = "Betrag in T LW" Then GoTo nächstesi
If Cells(12, i + 1) = "Betrag in TLW" Then GoTo nächstesi
GoTo Kopieren
End If
nächstesi:
Next i
Kopieren:
For L = 1 To 5
If L = 1 Then Land = "SK"
If L = 2 Then Land = "HR"
If L = 3 Then Land = "PL"
If L = 4 Then Land = "RO"
If L = 5 Then Land = "BG"
ThisWorkbook.Activate
Worksheets(Land).Activate
Worksheets(Land).Range("C11:F21").Copy _
Destination:=Worksheets(Land).Range(Cells(11, i + 1), Cells(21, i + 4))
For j = i + 1 To i + 5
With Worksheets(Land).Columns(j)
.ColumnWidth = 20
End With
Next j
Workbooks.Open Filename:=(Path & "\Kartenzahlung " & Jahr & Monat) 'Zielfile wird geöffnet
Worksheets(Land & " " & Monat & Jahr).Activate
DebitF = Cells(28, 9)
VisaF = Cells(32, 9)
MasterCardF = Cells(33, 9)
AmexF = Cells(34, 9)
DinersF = Cells(35, 9)
Umsatzbrutto = Cells(45, 3)
umsatzbar = Cells(46, 3)
UmsatzKarte = Cells(47, 3)
davondebit = Cells(48, 3)
davoncredit = Cells(53, 3)
Visa = Cells(54, 3)
MasterCard = Cells(55, 3)
Amex = Cells(56, 3)
Diners = Cells(57, 3)
TUmsatzbrutto = Cells(45, 10)
TUmsatzbar = Cells(46, 10)
TUmsatzKarte = Cells(47, 10)
Tdavondebit = Cells(48, 10)
Tdavoncredit = Cells(53, 10)
TVisa = Cells(54, 10)
TMasterCard = Cells(55, 10)
TAmex = Cells(56, 10)
TDiners = Cells(57, 10)
BUmsatzbrutto = Cells(45, 17)
BUmsatzbar = Cells(46, 17)
BUmsatzKarte = Cells(47, 17)
Bdavondebit = Cells(48, 17)
Bdavoncredit = Cells(53, 17)
BVisa = Cells(54, 17)
BMasterCard = Cells(55, 17)
BAmex = Cells(56, 17)
BDiners = Cells(57, 17)
ThisWorkbook.Activate
Worksheets(Land).Activate
Cells(13, i + 1) = Umsatzbrutto
Cells(14, i + 1) = umsatzbar
Cells(15, i + 1) = UmsatzKarte
Cells(16, i + 1) = davondebit
Cells(17, i + 1) = davoncredit
Cells(18, i + 1) = Visa
Cells(19, i + 1) = MasterCard
Cells(20, i + 1) = Amex
Cells(21, i + 1) = Diners
Cells(16, i + 2) = DebitF
Cells(18, i + 2) = VisaF
Cells(19, i + 2) = MasterCardF
Cells(20, i + 2) = AmexF
Cells(21, i + 2) = DinersF
Cells(13, i + 3) = TUmsatzbrutto
Cells(14, i + 3) = TUmsatzbar
Cells(15, i + 3) = TUmsatzKarte
Cells(16, i + 3) = Tdavondebit
Cells(17, i + 3) = Tdavoncredit
Cells(18, i + 3) = TVisa
Cells(19, i + 3) = TMasterCard
Cells(20, i + 3) = TAmex
Cells(21, i + 3) = TDiners
Cells(13, i + 4) = BUmsatzbrutto
Cells(14, i + 4) = BUmsatzbar
Cells(15, i + 4) = BUmsatzKarte
Cells(16, i + 4) = Bdavondebit
Cells(17, i + 4) = Bdavoncredit
Cells(18, i + 4) = BVisa
Cells(19, i + 4) = BMasterCard
Cells(20, i + 4) = BAmex
Cells(21, i + 4) = BDiners
Datum = "01." & Monat & "." & Jahr
Cells(11, i + 1) = Datum
Next L
For Each w In Workbooks 'alle Workbooks bis auf das aus dem VBA ausgeführt wird, werden _
geschlossen
If w.Name ThisWorkbook.Name Then
w.Close savechanges:=True
End If
Next w
L = 1
For L = 1 To 5
If L = 1 Then Land = "SK"
If L = 2 Then Land = "HR"
If L = 3 Then Land = "PL"
If L = 4 Then Land = "RO"
If L = 5 Then Land = "BG"
Worksheets(Land).Activate
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
ActiveWindow.Visible = False
Cells(22, i + 1).Select
ActiveSheet.Paste
ActiveSheet.Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SetSourceData Source:=Sheets(Land).Range( _
umsatzbar, davondebit & ":" & davoncredit, "B14,B16:B17"), PlotBy:=xlColumns
Next L
End Sub