Auswertung über mehrere Blätter

Erst einmal wünsche ich allen ein schönes Wochenende, mit hoffentlich ertragbaren Wetter!
Sorry, dass ich das Thema noch einmal einstelle. Ich hatte am 06. das Thema eingestellt und auch eine Antwort bekommen. Das Makro funktioniert leider nicht, sondern bringt eine Fehlermeldung.
Ich stelle noch einmal den kompletten Text ein, vielleicht hat ja jemand Zeit mal drüber zu schauen.
Folgendes Problem. Ich habe in einer Exceldatei 12 Blätter (Shett 1-12)
In allen Blättern stehen in folgenden Zellen, folgende Werte
B4:B48 = Name
C4:C48 = Vorname
F4:F48 = Zahl
G4:G48 = Zahl
Im Blatt 14 möchte ich beginnend ab der Zelle B2 alle diese Einträge haben, sortiert nach der Zahl welche im Bereich "G" steht, mit der größten beginnend.
Vorschlag:

Sub Sammeln()
For i = 1 To 12
Bereich = Union(Worksheets(i).Range("B4:C48"), Worksheets(i).Range("F4:G48"))
Bereich.Copy Destination:=Worksheets(14).Cells((i - 1) * 45 + 2, 2)
Next i
End Sub

Hier kommt dann ein Laufzeitfehler:
Bereich.Copy Destination:=Worksheets(14).Cells((i - 1) * 45 + 2, 2)
mit der Fehlermeldung Objekt fehlt.
Danke für eure Bemühungen...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub Sammeln() Dim i As Long, Bereich As Range For i = 1 To 12 Set Bereich = Union(Worksheets(i).Range("B4:C48"), Worksheets(i).Range("F4:G48")) Bereich.Copy Destination:=Worksheets(14).Cells((i - 1) * 45 + 2, 2) Next i End Sub

Sub Sammeln() Dim i As Long, Bereich As Range, Spalte As Long For i = 1 To 12 Set Bereich = Union(Worksheets(i).Range("B4:C48"), Worksheets(i).Range("F4:G48")) Bereich.Copy Destination:=Worksheets(14).Cells((i - 1) * 45 + 2, 2) Next i With Worksheets(14) 'Sortieren With .Range(.Cells(2, 2), .Cells(2 + 12 * 45 - 1, 5)) .Sort key1:=.Range("D1"), Order1:=xlDescending, Header:=xlNo End With 'letzte Datenzeile in Spalten B bis D ermitteln i = 0 For Spalte = 2 To 4 i = Application.WorksheetFunction.Max(i, .Cells(.Rows.Count, Spalte).End(xlUp).Row) Next 'ggf. Zeilen mit leeren Zellen in Spalte G löschen If i > .Cells(.Rows.Count, 5).End(xlUp) Then .Range(.Cells(.Rows.Count, 5).End(xlUp).Offset(1, -3), _ .Cells(i, 2)).EntireRow.Delete End If End With End Sub

Beliebteste Forumthreads (12 Monate)

Auswertung über mehrere Blätter

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Auswertung über mehrere Blätter

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread