|
Hallo Rog!
Habe das mit dem Datum mal geändert. Er prüft jetzt, ob der WErt in der ersten Zeile ein Datum ist. Wenn ja, sucht er den Wert. Probier mal bitte, ob das so wie gewünscht klappt und alle Daten gesucht und die Werte dazu eingetragen werden. Schöne Woche noch. VG
Sub übertrag()
Dim lzeile As Long
Dim lspalte As Long
Dim blätter()
Dim blatt
Dim anzahl As Long
Dim i As Long
Dim j As Long
Dim index
ReDim blätter(0)
anzahl = 0
For Each blatt In Worksheets
anzahl = anzahl + 1
ReDim Preserve blätter(anzahl)
blätter(anzahl) = blatt.Name
Next blatt
lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lspalte = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 5 To lzeile
If ActiveSheet.Cells(i, 1) <> "" Then
index = ActiveSheet.Cells(i, 1)
If UBound(Filter(blätter, index)) > -1 Then
For j = 1 To lspalte 'hier ggf. anpassen, wenn er in einer späteren Spalte anfangen soll, ansonsten geht es bei 1 los
If IsDate(ActiveSheet.Cells(1, j)) Then
ActiveSheet.Cells(i, j) = Worksheets(index).Cells(2, Application.WorksheetFunction.Match(ActiveSheet.Cells(1, j), Worksheets(index).Rows(1), 0))
End If
Next j
End If
End If
Next i
End Sub
|