Option Explicit
Sub listenauswertung()
' Variablen deklarieren
Dim vUebArrKd As Variant
Dim Blatt As Object
Dim lZielUeb As Long
Dim lZielUeb2 As Long
Dim iZiel As Integer ' _
Letzte gefüllte Zelle
Dim az As Integer ' Zä _
hler für Arrayfelder
Dim i As Integer ' _
Schleifenzähler (Arrays füllen)
Dim arr() As Variant ' Array _
für Datenausgabe
Dim lZeile As Long
Dim vDatArr As Variant
Dim iSpalte As Integer
Dim sWs As String
Application.ScreenUpdating = False
vDatArr = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", " _
September", "Oktober", "November", "Dezember")
' Kunden übertragen
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Then
lZielUeb = Sheets(Blatt.Name).Range("A65536").End(xlUp).Row
vUebArrKd = Sheets(Blatt.Name).Range("A2", "A" & lZielUeb).Value
lZielUeb2 = Sheets("Auswertung").Range("A65536").End(xlUp).Row + 1
Sheets("Auswertung").Range("A" & lZielUeb2, "A" & lZielUeb2 + lZielUeb - 2) = vUebArrKd
End If
Next Blatt
' Mehrfachnennungen von Kunden beseitigen
' Geschrieben von Klaus-Dieter Oppermann, Oktober 2005
' angepasst von Donkey August 2006
iZiel = Sheets("Auswertung").Range("A65536").End(xlUp).Row ' _
Letzte gefüllte Zelle ermitteln (in Spalte A)
' Array dimensionieren
ReDim arr(iZiel, 0) ' Feld _
nach Listenlänge festlegen
' Arrays mit Werten füllen
For i = 2 To UBound(arr) ' laufe _
von Zeile 2 bis Tabellenende
If Application.WorksheetFunction.CountIf(Range(Sheets("Auswertung").Cells(i, 1), _
Sheets("Auswertung").Cells(1, 1)), Sheets("Auswertung").Cells(i, 1).Value) = 1 Then ' wenn _
Wert das erste Mal vorkommt, dann ...
arr(az, 0) = Sheets("Auswertung").Cells(i, 1).Value ' ... _
Name in Array einlesen
az = az + 1 ' ... Zä _
hler für Arrayfeld plus 1
End If ' Ende _
der Auswertung
Next i ' _
Schleifenzähler plus 1
' Inhalte ausgeben
Sheets("Auswertung").Range("A2", "A" & UBound(arr)) = arr ' Werte _
in Ausgabebereich schreiben
' Summen ermitteln
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Then
iSpalte = 2
sWs = Left(Blatt.Name, Len(Blatt.Name) - 4)
Do While sWs Sheets("Auswertung").Cells(1, iSpalte)
iSpalte = iSpalte + 1
Loop
lZielUeb = Sheets(Blatt.Name).Range("A65536").End(xlUp).Row
For lZeile = 2 To az + 1
Sheets("Auswertung").Cells(lZeile, iSpalte) = Application.WorksheetFunction.SumIf( _
Range(Sheets(Blatt.Name).Cells(lZielUeb, 3), _
Sheets(Blatt.Name).Cells(2, 1)), Sheets("Auswertung").Cells(lZeile, 1), Sheets( _
Blatt.Name).Range("B2", "I" & lZielUeb))
Sheets("Auswertung").Cells(lZeile, 14) = Application.WorksheetFunction.Sum(Range("B" _
& lZeile, "M" & lZeile))
Next lZeile
End If
Next Blatt
With Sheets("Auswertung").Range("B2", "N" & az + 1)
.NumberFormat = "#,##0"
End With
Sheets("Auswertung").Columns("A:N").EntireColumn.AutoFit ' _
Spalten auf optimale Breite
Application.ScreenUpdating = False
End Sub
mit oben stehende Code von Klaus-Dieter Oppermann und Donkey werden aus alle Tabelleblätter Januar '06 bis Dezember '06 die werte von Spalte A und B in eine Liste Tabelleblatt Auswertung zusammengefügt.
soweit kein Problem, aber ich mochte gerne die anzahl Tabelleblätter erweiteteren über eine längere zeitraum 07, 08
ich scheitere am code
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Then wie kann mann dass lösen.
Summewert im Blat Auswertung ist nicht unbedingt nötig.
beispiel zugefügt
https://www.herber.de/bbs/user/62832.xls
Karel