Makro zum verschieben von Daten

Hallo Zusammen,

in meiner Beispieldatei sind zwei Blätter.
Einmal das Blatt FileList und das Blatt Matrix.

Im Blatt FileList sind Dateinamen in Spalte A aufgelistet. In Spalte B steht das Änderungsdatum.Es sind Daten aus den letzten 30 Tagen.
Sie sind immer Absteigend sortiert mit dem neusten zuerst.Es kommen immer neue dazu mit anderm datum.

Durch das Makro "KopiereWerteMitFormatierung" werden die Daten in das Blatt Matrix kopiert.
Ab Spalte B werden die Deteinamen aufgelistet. In der Spalte A stehen Namen und wenn ein Name die Datei zum Beispiel gelesen hat,wird ein Kreuz gesetzt.
Das klappt auch alles.

Problem:
Ich möchte aber gerne wenn jetzt auf dem Blatt FileList neue Daten hinzukommen mit einem neuen Datum das auf dem Blatt Matrix die älteren nach rechts verschoben werden so das die
Kreuze dort bleiben wo sie sind zu dem passenden Dateinamen in Zeile 1.

Die Neuen stehen dann also im Blatt Matrix vorne. Sollten das datum älter als 30 Tage sein soll der Eintrag im Blazz Matrix hinten gelöscht werden.
https://www.herber.de/bbs/user/162353.xlsm

Leider bekomme ich es nicht hin. Eventuell hat jemand eine Idee ?

Danke und Gruß Bernd_

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Bernd!

Den vorhanden Code hab ich vereinfacht und versucht die Anforderung umzusetzen.

Probier das mal:



Sub KopiereWerteMitFormatierung()

    Dim QuellBlatt As Worksheet

    Dim ZielBlatt As Worksheet

    Dim LetzteZeile As Long

    

    ' Definiere die Quell- und Zielblätter

    Set QuellBlatt = ThisWorkbook.Sheets("FileList")

    Set ZielBlatt = ThisWorkbook.Sheets("Matrix")

    

    LetzteZeile = QuellBlatt.Cells(QuellBlatt.Rows.Count, "A").End(xlUp).Row ' Finde die letzte Zeile im Quellblatt

    QuellBlatt.Range("A2:A" & LetzteZeile).Copy

    ZielBlatt.Cells(1, 2).PasteSpecial xlPasteAllUsingSourceTheme, Transpose:=True

    ZielBlatt.Cells.Columns.AutoFit



    Sheets("Matrix").Select

    Range("B2").Select

   

End Sub



Sub Aktuell_test()

    Dim QuellBlatt As Worksheet

    Dim ZielBlatt As Worksheet

    Dim cl As Range

    Dim gefunden As Range

    Set QuellBlatt = ThisWorkbook.Sheets("FileList")

    Set ZielBlatt = ThisWorkbook.Sheets("Matrix")

    

    'Test ob eingetrgene Daten noch vorhandenen und aktuell sind

    For Each cl In ZielBlatt.Range("B1:ZZ1").SpecialCells(xlConstants) 'Spalten durch gehen zum löschen

        Set gefunden = QuellBlatt.Cells.Find(cl.Value, lookat:=xlWhole)

        If Not gefunden Is Nothing Then 'gefunden!

            If gefunden.Offset  Date - 30 Then cl.Columns.EntireColumn.Delete 'älter 30 Tage

        End If

    Next cl

    

    'gegenprobe, sind vorhandene Daten >30 Tage auch eingetragen

    For Each cl In QuellBlatt.Range("A2:A" & Rows.Count).SpecialCells(xlConstants)

        If cl.Offset(0, 1) > Date - 30 Then 'Datumsprüfung

            With ZielBlatt

                Set gefunden = .Rows(1).Find(cl.Value, lookat:=xlWhole) 'schon vorhanden?

                If gefunden Is Nothing Then 'nicht gefunden!

                    .Range("B:B").Insert xlToRight 'spalte einfügen

                    .Range("C:C").Copy

                    .Range("B:B").PasteSpecial xlPasteFormats 'format übernehmen

                    .Range("B1") = cl.Value

                End If

            End With

        End If

    Next cl

End Sub

Gruß, MCO

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro zum verschieben von Daten

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread