Office: Mehrere Blätter zusammen fassen und mehr

Jawoll, alles klar. Das war mein Fehler.

Jetzt ist alles so, wie ich es haben wollte!!!!

1000 Dank. Ganz ehrlich, bin wirklich begeistert!!!!

:-D :-D :-D :-D :-D :-D :-D :-D

 

Es geht noch weiter: Jetzt mehrere Dateien

Jetzt hab ich also 5 Dateien (jeweils mit verschiedener TN-Zahl, aber alle mit dem "Gesamt"-Blatt).
Die Summen aus diesen "Gesamt"-Blättern sollen nun in einer sechsten Datei zusammen gefasst werden.
Hab das mit folgendem Code probiert, läuft aber nichts. Da fang ich lieber nochmal von vorne an ...

Sub Test()
Dim Mappe As String
Const Pfad = "C:\Dokumente und Einstellungen\Admin\Desktop\Akademie\"
Mappe = Dir(Pfad & "Vorlage Auswertung Gruppe*.xls")
Do While Mappe <> ""
Workbooks.Open Pfad & Mappe, UpdateLinks:=0
Workbooks(Mappe).Sheets("Gesamt").UsedRange.Offset(2, 0).Copy _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
Workbooks(Mappe).Close SaveChanges:=False
Mappe = Dir
Loop
End Sub

Oder steckt da doch NUR ein kleiner Fehler drin?

 

Hallo!

Eigentlich ist da gar kein Fehler drin.
(Das Makro kommt mir auch irgendwie bekannt vor...)

Es kommt natürlich darauf an, was du wohin kopieren möchtest...

 

;-) Na gut, hab ich mich vorher hier etwas umgeschaut ...


Die sechste Datei soll auch eine "Kopie" der Tabelle der ersten fünf "Gesamt"-Blätter werden.
Hab die auch rein kopiert und den Code auch, aber wie dann weiter?

 

Hallo!

Könntest du das etwas genauer beschreiben?
Ich verstehe nicht so recht, worauf du hinaus willst...

 

Stimmt, ist auch einfacher als ich's geschrieben habe.

Die sechste Datei soll genau so aussehen, wie das Blatt "Gesamt" in den ersten fünf Dateien (die alle identisch sind).
Dann befinden sich ja in allen fünf "Gesamt"-Blättern Summen der "x".
Die sechste Datei soll dann die Summe aus den Summen werden ...
Also ein Gesamt-"Gesamt"-Blatt.

Irgendwie bin ich nicht so gut im Beschreiben.
Ich glaub', besser krieg' ich's nicht.

 

Hallo!

Das habe ich zwar vermutet, aber es war aus deinen Angaben beim besten Willen nicht rauszulesen...

VBA-Profis werden wahrscheinlich die Hände über dem Kopf zusammenschlagen, aber teste doch mal dies (dein Zielblatt muss in diesem Fall auch "Gesamt" heißen!!!):

Code:

Sub Test()
Dim Mappe As String, Bereich As Range, i%, Arr, x As String
Const Pfad = "E:\Test\Test\"                '<-- Hier anpassen
x = "A3:D6"                                 '<-- Hier anpassen
With ActiveWorkbook.Sheets("Gesamt")
Set Bereich = .Range(x)
ReDim Arr(1 To Bereich.Cells.Count)
Mappe = Dir(Pfad & "Mappen*.xls")           '<-- Hier anpassen
Do While Mappe <> ""
Workbooks.Open Pfad & Mappe, UpdateLinks:=0
Set Bereich = .Range(x)
For i = 1 To Bereich.Cells.Count
Arr(i) = Arr(i) + Bereich.Cells(i)
Next i
Workbooks(Mappe).Close SaveChanges:=False
Mappe = Dir
Loop
Set Bereich = .Range(x)
For i = 1 To Bereich.Cells.Count
Bereich.Cells(i) = Arr(i)
Next i
End With
End Sub

 

Oh, ich hab noch was vergessen:

In den fünf "Gesamt"-Blättern sind ja nur Zahlen (die Summe der "x").
Weil: Der zählt jetzt gar nichts, oder muss ich den Code noch gesondert aktivieren?!

Wenn ich da "Vorlage Gruppe 1.xls" haben will, muss dann vor das * noch ein Leerzeichen?

 

Irgendwas scheint auf dem Datenhighway hängen geblieben zu sein...

Aber zu dem, was bisher ankam:
Das "x" im Code hat nur zufällige Ähnlichkeit mit dem "x" in der Tabelle und hat nix damit zu tun:

Sub Test()
Dim Mappe As String, Bereich As Range, i%, Arr, WasAnderes As String
Const Pfad = "E:\Test\Test\"
WasAnderes = "A3:D6"
With ActiveWorkbook.Sheets("Gesamt")
Set Bereich = .Range(WasAnderes)
ReDim Arr(1 To Bereich.Cells.Count)
Mappe = Dir(Pfad & "Mappen*.xls")
Do While Mappe <> ""
Workbooks.Open Pfad & Mappe, UpdateLinks:=0
Set Bereich = .Range(WasAnderes)
For i = 1 To Bereich.Cells.Count
Arr(i) = Arr(i) + Bereich.Cells(i)
Next i
Workbooks(Mappe).Close SaveChanges:=False
Mappe = Dir
Loop
Set Bereich = .Range(WasAnderes)
For i = 1 To Bereich.Cells.Count
Bereich.Cells(i) = Arr(i)
Next i
End With
End Sub

Das Platzhalter-* kann eigentlich auch kein Problem (bei was auch immer) sein.

 

Sorry, aber funktioniert einfach nicht.
So sieht's jetzt aus:

Sub Test()
Dim Mappe As String, Bereich As Range, i%, Arr, x As String
Const Pfad = "C:\Dokumente und Einstellungen\Admin\Desktop\Akademie"
x = "B6:J125"
With ActiveWorkbook.Sheets("Gesamt")
Set Bereich = .Range(x)
ReDim Arr(1 To Bereich.Cells.Count)
Mappe = Dir(Pfad & "Vorlage Auswertung Gruppe *.xls")
Do While Mappe <> ""
Workbooks.Open Pfad & Mappe, UpdateLinks:=0
Set Bereich = .Range(x)
For i = 1 To Bereich.Cells.Count
Arr(i) = Arr(i) + Bereich.Cells(i)
Next i
Workbooks(Mappe).Close SaveChanges:=False
Mappe = Dir
Loop
Set Bereich = .Range(x)
For i = 1 To Bereich.Cells.Count
Bereich.Cells(i) = Arr(i)
Next i
End With
End Sub

Was hab ich denn noch falsch gemacht???????

 

Spontan fällt mir das hier auf:

Const Pfad = "C:\Dokumente und Einstellungen\Admin\Desktop\Akademie\"

Alles andere kann ich aus der Ferne nicht beurteilen.
An welcher Stelle hängt der Code denn überhaupt?

 

So, da bin ich wieder. Wieder gesund und motiviert! :lol:

Ich habe keine Ahnung an welcher Stelle der Code hängt!

Ich habe einen Button erstellt "Auswertung starten" und ihm den Code zugewiesen.
Wenn ich ihn drücke, flackert alles ein paar Mal und dann stehen überall Nullen, obwohl ich in einer der fünf Dateien mehrere "x" gemacht habe?!

Auch "in" den Überschriften stehen Nullen. Kann ich hier vielleicht doch mit B6:D10 und dann wieder B12:D16 usw. weiter machen?