HERBERS Excel-Forum - das Archiv

Thema: Daten aus mehreren Sheets konsolidieren | Herbers Excel-Forum

Daten aus mehreren Sheets konsolidieren
Detlef

Hallo,
ich möchte aus meheren Sheets Daten konsolidieren.
Ich bekomme regelmäßig eine Excel Datei, in der auf mehrere Sheets verteilt für mich relevante Daten sind. Da es sehr mühsam ist, diese einzeln herauszusuchen, stelle ich mir Folgendes vor:
Ich gebe meinen Suchbegriff ein. Excel durchsucht danach auf allen Sheets die Spalte A und kopiert bei einem Treffer die jeweilige Zeile zusammen mit der Überschriftszeile 1 in eine neue Excel Datei.
Geht das?
Vielen Dank und viele Grüße, Detlef

AW: Daten aus mehreren Sheets konsolidieren
Beni

Hallo Detlef,
öffne die Datei mit den Daten und starte dieses Makro in einer separaten Arbeitsmappe.
Gruss Beni
https://www.herber.de/bbs/user/66501.xlsm
Sub Daten_aus_mehreren_Sheets_konsolidieren()
Wert = InputBox("Suchwert eingeben", "Titel")
W = CStr(Wert)
actWB = ActiveWorkbook.Name
For wb = 1 To Workbooks.Count
If wb = 3 Then MsgBox "Es dürfen nur zwei Workbooks geöffnet sein": Exit Sub
If Not Workbooks(wb).Name = actWB Then datWB = Workbooks(wb).Name
Next wb
Workbooks.Add
neuWB = ActiveWorkbook.Name
Windows(datWB).Activate
Set neuWB = Workbooks(neuWB).Sheets(1)
For sh = 1 To Sheets.Count
With Workbooks(datWB).Sheets(sh)
ls = .Cells(1, Columns.Count).End(xlToLeft).Column
Range(.Cells(1, 1), .Cells(1, ls)).Copy neuWB.Cells(1, 1)
For Z = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
nz = neuWB.Cells(Rows.Count, 1).End(xlUp).Row + 1
If CStr(.Cells(Z, 1)) = W Then
Range(.Cells(Z, 1), .Cells(Z, ls)).Copy neuWB.Cells(nz, 1)
End If
Next Z
End With
Next sh
End Sub