Flytte data automatisk fra 1 ark til et andet efter udløbsdato

Det er nok kodesproget (aka vba) som kan gøre det automatisk for dig. Hvis du kan overskue en manuel proces kan du vælge et filter på dine data og så søge efter de røde farve og klippe det over i nyt ark på een gang.

Hvis du gerne vil automatik har vi brug for at kende din datastruktur, måske et eksempel på data uploadet til dropbox eller lignende.

Hvis du ikke har beregninger i dine data,
kan du lave et ark2,
hvor hver celle i ark2 = tilsvarende celle i ark1,
og al tekst-farve er hvid (usynlig).
Du laver derefter betinget formattering i ark1,
hvor Tekst-farve i forældede data bliver hvid,
mens Tekst-farven i forældede data i ark2 bliver sort.

Løsningen kan være to vba'er. Den første er nødvendig fordi vba ikke kan "se" farven på tekst lavet via betinget formattering.

Sub mark_date()
' definer variable
Dim intRaekke As Integer
Dim rngCelle As Range
Dim intSidsteRaekke As Integer

' find sidste række i listen for ikke at køre flere rækker end nødvendigt.
intSidsteRaekke = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

' strukturen af arket starter i række 3 med data
For intRaekke = 3 To intSidsteRaekke

    Set rngCelle = Cells(intRaekke, 10)

   
    If IsEmpty(rngCelle.Value) Then
        rngCelle.Font.Color = vbBlack
    ElseIf rngCelle.Value > Date Then
        rngCelle.Font.Color = vbGreen
    ElseIf rngCelle.Value < Date Then
        rngCelle.Font.Color = vbRed
    Else: rngCelle.Font.Color = vbYellow
    End If
Next intRaekke

End Sub

Kopiering til fane 5 (ikke brugt navn, men 5 kan erstattes via "arknavn"
Sub move_red_dates()

Dim intRaekke As Integer
Dim intSidsteRaekke As Integer

intSidsteRaekke = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

For intRaekke = 3 To intSidsteRaekke
If Cells(intRaekke, 10).Font.Color = vbRed Then
    Rows(intRaekke).EntireRow.Cut
    Sheets(5).Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    ActiveSheet.Paste
   
End If
Next intRaekke
MsgBox ("Rows moved to Sheet: " & Sheets(5).Name)
End Sub

Jeg har på stående fod ikke checket om det giver udfordringer at jeg selecter ark 5 i if sætningen. Du må lige sige til hvis det skaber sig, så skal der en lille krølle på.

Jeg har også sendt arket til dig på mail.

Hej Kim
Det ser ud til vi næsten er i mål, men når jeg åbner databasen så er der fortsat røde datoer i det første ark, og intet i ark 5 (udløbne)? Er der noget jeg har misforstået?
Skal jeg fysisk gøre noget med VBA koden for at få det til at virke?
Fortsat tusinde tak for alt din hjælp og tålmodighed med mig:-)
Mvh Julie

Du skal køre de to koder, først den som markerer og dernæst den som flytter. Hver gang du opdaterer arket, jeg er lidt i tvivl om du har gjort det?

Det er ikke en auto-løsning. Det kunne man gør lave det til, men kræver en smule tilretning i hvor koden ligger.

Kører man koderne under makroer?

Ja, du kan vælge dem direkte fra "udvikler" tab'en og så makro og vælg dem en efter en.

Det virker!!!! Tusinde tak Kim - jeg er ovenud taknemmelig for din hjælp!
MVH Julie