Code:
Sub aufsummieren_und_verteilen()
Dim i As Long, j As Long
Dim lngSpalte As Long, lngZZ As Long
Dim lngZSumme As Long, lngZPlz As Long
Dim strgBereich As String, strgZählen As String, strgSummen
Dim feldSummen
Dim feldUmsatz
Sheets("2. ---> Daten entnehmen").Cells.Clear
Application.ScreenUpdating = False
With Sheets("PLZ nicht verändern")
lngZPlz = .Cells(Rows.Count, 1).End(xlUp).Row
strgBereich = "'PLZ nicht verändern'!" & .Range("A2:A" & lngZPlz).Address
End With
With Sheets("1. ---> Daten einfügen")
lngZSumme = .Cells(Rows.Count, 1).End(xlUp).Row
lngSpalte = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1
strgZählen = .Range(.Cells(6, lngSpalte), .Cells(lngZSumme, lngSpalte)).Address
strgSummen = .Range(.Cells(lngZSumme + 1, 2), .Cells(lngZSumme + 1, lngSpalte - 1)).Address
.Range(strgZählen).FormulaLocal = "=Zählenwenn(" & strgBereich & ";A6)"
.Range(strgZählen).Value = .Range(strgZählen).Value
.Range(strgSummen).FormulaLocal = "=SUMMEWENN(" & strgZählen & ";0;B6:B2628)"
feldSummen = .Range(strgSummen)
.Range(strgSummen).Clear
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
.Range(.Cells(1, 1), .Cells(lngZSumme + 1, lngSpalte)).AutoFilter Field:=lngSpalte, Criteria1:=">0", _
Operator:=xlAnd
Else
.Range(.Cells(1, 1), .Cells(lngZSumme + 1, lngSpalte)).AutoFilter Field:=lngSpalte, Criteria1:=">0", _
Operator:=xlAnd
End If
Sheets("2. ---> Daten entnehmen").Cells.Clear
.AutoFilter.Range.Offset(1, 0).Resize(, .AutoFilter.Range.Columns.Count - 1).Copy Sheets("2. ---> Daten entnehmen").Range("A3")
.AutoFilterMode = False
.Range(strgZählen).Clear
End With
With Sheets("2. ---> Daten entnehmen")
lngZZ = .Cells(.Rows.Count, 1).End(xlUp).Row
feldUmsatz = .Range(.Cells(3, 2), .Cells(lngZZ, lngSpalte - 1))
For j = 1 To lngSpalte - 2
For i = 1 To lngZZ - 2
feldUmsatz(i, j) = Application.WorksheetFunction.Round(feldUmsatz(i, j) + feldSummen(1, j) / (lngZZ - 4), 2)
Next i
Next j
.Range(.Cells(3, 2), .Cells(lngZZ, lngSpalte - 1)) = feldUmsatz
Überschriften
.Rows.Hidden = False
End With
Application.ScreenUpdating = True
End Sub
Sub Überschriften()
With Sheets("2. ---> Daten entnehmen")
.Range("A1:V1") = Array("PLZ", "BV Gesamt 2014", "KV Gesamt 2014", "Gesamt 2014", "BV 01 Schlafen 2014", "KV 01 Schlafen 2014", "Gesamt 01 Schlafen 2014", "BV 02 Anbauwände 2014", "KV 02 Anbauwände 2014", "Gesamt 02 Anbauwände 2014", "BV 03 Küchen & Bäder 2014", "KV 03 Küchen & Bäder 2014", "Gesamt 03 Küchen & Bäder 2014", "BV 04 Polstermöbel 2014", "KV 04 Polstermöbel 2014", "Gesamt 04 Polstermöbel 2014", "BV 05 Kleinmöbel 2014", "KV 05 Kleinmöbel 2014", "Gesamt 05 Kleinmöbel 2014", "BV 06 Speisezimmer 2014", "KV 06 Speisezimmer 2014", "Gesamt 06 Speisezimmer 2014")
.Range("W1:AQ1") = Array("BV 08 Mitnahme 2014", "KV 08 Mitnahme 2014", "Gesamt 08 Mitnahme 2014", "BV 09 KiBa 2014", "KV 09 KiBa 2014", "Gesamt 09 KiBa 2014", "BV 80 Leuchten 2014", "KV 80 Leuchten 2014", "Gesamt 80 Leuchten 2014", "BV 92 Bilder 2014", "KV 92 Bilder 2014", "Gesamt 92 Bilder 2014", "BV 93-97 Heimtex 2014", "KV 93-97 Heimtex 2014", "Gesamt 93-97 Heimtex 2014", "BV Boutique 2014", "KV Boutique 2014", "Gesamt Boutique 2014", "BV Orient 2014", "KV Orient 2014", "Gesamt Orient 2014")
.Range("AR1:BL1") = Array("BV Gesamt 2015", "KV Gesamt 2015", "Gesamt 2015", "BV 01 Schlafen 2015", "KV 01 Schlafen 2015", "Gesamt 01 Schlafen 2015", "BV 02 Anbauwände 2015", "KV 02 Anbauwände 2015", "Gesamt 02 Anbauwände 2015", "BV 03 Küchen & Bäder 2015", "KV 03 Küchen & Bäder 2015", "Gesamt 03 Küchen & Bäder 2015", "BV 04 Polstermöbel 2015", "KV 04 Polstermöbel 2015", "Gesamt 04 Polstermöbel 2015", "BV 05 Kleinmöbel 2015", "KV 05 Kleinmöbel 2015", "Gesamt 05 Kleinmöbel 2015", "BV 06 Speisezimmer 2015", "KV 06 Speisezimmer 2015", "Gesamt 06 Speisezimmer 2015")
.Range("BM1:CG1") = Array("BV 08 Mitnahme 2015", "KV 08 Mitnahme 2015", "Gesamt 08 Mitnahme 2015", "BV 09 KiBa 2015", "KV 09 KiBa 2015", "Gesamt 09 KiBa 2015", "BV 80 Leuchten 2015", "KV 80 Leuchten 2015", "Gesamt 80 Leuchten 2015", "BV 92 Bilder 2015", "KV 92 Bilder 2015", "Gesamt 92 Bilder 2015", "BV 93-97 Heimtex 2015", "KV 93-97 Heimtex 2015", "Gesamt 93-97 Heimtex 2015", "BV Boutique 2015", "KV Boutique 2015", "Gesamt Boutique 2015", "BV Orient 2015", "KV Orient 2015", "Gesamt Orient 2015")
.Range("CH1:DA1") = Array("BV Gesamt 2016", "KV Gesamt 2016", "Gesamt 2016", "BV 01 Schlafen 2016", "KV 01 Schlafen 2016", "Gesamt 01 Schlafen 2016", "KV 02 Anbauwände 2016", "Gesamt 02 Anbauwände 2016", "BV 03 Küchen & Bäder 2016", "KV 03 Küchen & Bäder 2016", "Gesamt 03 Küchen & Bäder 2016", "BV 04 Polstermöbel 2016", "KV 04 Polstermöbel 2016", "Gesamt 04 Polstermöbel 2016", "BV 05 Kleinmöbel 2016", "KV 05 Kleinmöbel 2016", "Gesamt 05 Kleinmöbel 2016", "BV 06 Speisezimmer 2016", "KV 06 Speisezimmer 2016", "Gesamt 06 Speisezimmer 2016")
.Range("DB1:DV1") = Array("BV 08 Mitnahme 2016", "KV 08 Mitnahme 2016", "Gesamt 08 Mitnahme 2016", "BV 09 KiBa 2016", "KV 09 KiBa 2016", "Gesamt 09 KiBa 2016", "BV 80 Leuchten 2016", "KV 80 Leuchten 2016", "Gesamt 80 Leuchten 2016", "BV 92 Bilder 2016", "KV 92 Bilder 2016", "Gesamt 92 Bilder 2016", "BV 93-97 Heimtex 2016", "KV 93-97 Heimtex 2016", "Gesamt 93-97 Heimtex 2016", "BV Boutique 2016", "KV Boutique 2016", "Gesamt Boutique 2016", "BV Orient 2016", "KV Orient 2016", "Gesamt Orient 2016")
.Range("DW1:EP1") = Array("BV Gesamt 2017", "KV Gesamt 2017", "Gesamt 2017", "BV 01 Schlafen 2017", "KV 01 Schlafen 2017", "Gesamt 01 Schlafen 2017", "KV 02 Anbauwände 2017", "Gesamt 02 Anbauwände 2017", "BV 03 Küchen & Bäder 2017", "KV 03 Küchen & Bäder 2017", "Gesamt 03 Küchen & Bäder 2017", "BV 04 Polstermöbel 2017", "KV 04 Polstermöbel 2017", "Gesamt 04 Polstermöbel 2017", "BV 05 Kleinmöbel 2017", "KV 05 Kleinmöbel 2017", "Gesamt 05 Kleinmöbel 2017", "BV 06 Speisezimmer 2017", "KV 06 Speisezimmer 2017", "Gesamt 06 Speisezimmer 2017")
.Range("EQ1:FK1") = Array("BV 08 Mitnahme 2017", "KV 08 Mitnahme 2017", "Gesamt 08 Mitnahme 2017", "BV 09 KiBa 2017", "KV 09 KiBa 2017", "Gesamt 09 KiBa 2017", "BV 80 Leuchten 2017", "KV 80 Leuchten 2017", "Gesamt 80 Leuchten 2017", "BV 92 Bilder 2017", "KV 92 Bilder 2017", "Gesamt 92 Bilder 2017", "BV 93-97 Heimtex 2017", "KV 93-97 Heimtex 2017", "Gesamt 93-97 Heimtex 2017", "BV Boutique 2017", "KV Boutique 2017", "Gesamt Boutique 2017", "BV Orient 2017", "KV Orient 2017", "Gesamt Orient 2017")
.Rows(2) = Sheets("1. ---> Daten einfügen").Rows(5).Value
End With
End Sub