Zusammenführung verschiedener Blätter

Forumthread: Zusammenführung verschiedener Blätter

15.02.2019 11:20:38

alex

Hallo zusammen,
ich habe folgendes Problem:
Arbeitsmappe mit 100 Blättern, davon 90 genau der gleich Aufbau (1. Zeile Überschrift, Spalten jeweils identisch aufgebaut). In Spalte D steht jeweils ein Datum (TT.MM.JJJJ).
Nun hätte ich gerne in einem neuen Tabellenblatt ein Feld, in das ich eine Jahreszahl JJJJ eingeben kann. Anschließend sollen alle Zeilen "reinkopiert" werden aus den 90 Blättern, deren Jahreszahl mit der eingegebenen übereinstimmt.
Vielen Dank für eure Hilfe, ich hatte es auch schon mit pivot probiert, jedoch wäre mir diese Lösung lieber.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zusammenführung verschiedener Blätter

15.02.2019 12:42:02

AlterDresdner

Hallo Alex,
und woran erkennt das Makro, aus welchem der 100 Blätter es kopieren soll?
Gruß der AlteDresdner

AW: Zusammenführung verschiedener Blätter

15.02.2019 12:43:02

AlterDresdner

Ei verflixt, der Haken...

AW: Zusammenführung verschiedener Blätter

15.02.2019 13:00:17

alex

Das erkennt das Makro z.B. über den Inhalt der Zelle A1, der ist bei den 90 identischen Blättern immer "ja", beim Rest irgendetwas anderes,

Das Problem hatten wir doch schon...

15.02.2019 13:20:24

Werner

Hallo Alex,
....und hatten es doch auch gelöst - oder sehe ich das falsch?
Warum überhaupt noch ein Beitrag?
Gruß Werner

AW: Zusammenführung verschiedener Blätter

15.02.2019 18:04:23

AlterDresdner

Hallo Alex,

Sub zusammenführen()
Dim Blatt As Object, i As Long, Zielblatt As Object, zielzeile As Long, firstline As Long
Const ZielName = "erg" 'anpassen!!
Const Suchjahr = "$A$2" 'anpassen!!
Set Zielblatt = ThisWorkbook.Sheets(ZielName)
If Not IsNumeric(Zielblatt.Range(Suchjahr)) Then Exit Sub
firstline = Zielblatt.Range(Suchjahr).Offset(1, 0).Row
i = WorksheetFunction.Max(firstline, Zielblatt.Cells(Rows.Count, 4).End(xlUp).Row)
Zielblatt.Rows(firstline & ":" & i).ClearContents
Application.ScreenUpdating = False
zielzeile = firstline
For Each Blatt In ThisWorkbook.Sheets
With Blatt
If .Cells(1, 1) = "ja" And .Name  Zielblatt.Name And IsDate(.Cells(2, 4)) Then
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If IsDate(.Cells(i, 4)) Then
If Year(.Cells(i, 4)) = Zielblatt.Range(Suchjahr) Then
.Rows(i).Copy Destination:=Zielblatt.Cells(zielzeile, 1)
zielzeile = zielzeile + 1
End If
End If
Next i
End If
End With
Next Blatt
Application.ScreenUpdating = True
Zielblatt.Activate
End Sub

Voraussetzung: Makro steht im Workbook (ThisWorkbook),
Zieltabelle heißt erg
Jahreszahl steht in erg(A1), Eintragungen beginnen in der Zeile darunter,
sonst ggfls. Konstanten anpassen.
Gruß der Martin

Beliebteste Forumthreads (12 Monate)

Zusammenführung verschiedener Blätter

Forumthread: Zusammenführung verschiedener Blätter

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread