Copy/Paste nach 2 Kriterien

Bild

Betrifft: Copy/Paste nach 2 Kriterien
von: Major
Geschrieben am: 20.08.2015 16:32:02

Hallo zusammen,
bin mal gespannt ob ich den Sachverhalt verständlich erklären kann.
Die Datei besteht aus Spalten mit Datum und die darunterliegenden Zellen haben versch. Formeln und Wert.
Ein Makro bei Dateistart soll dafür sorgen, dass das letzte Datum ganz rechts immer das Datum heute()+6 ist. Damit will ich bezwecken, dass sich die Datei selbstständig vergrössert. Die Daten in der Vergangenheit sind irrelevant.(habe bereits ein Makro das den vergagenen Daten die Formel entnimmt und die Spalte ausblendet)
Also müsste wohl quasi immer die letzte Spalte komplett kopiert und 1 Spalte nach rechts verschoben werden. Natürlich mit dem richtigen Datum. Die Zellen enthalten Formeln mit relativen Bezügen, die weitergeführt werden müssen.
Man beachte...das muss auch funktionieren, wenn die Datei längere Zeit nicht geöffnet wurde, beispielsweise über das Wochenende.
Habe hier eine Beispieldatei hochgeladen...habe alle Zeilen des Makros kommentiert, damit das Makro in dieser Form nicht losgeht. Endet nämlich in einer Endlosschleife, weiss hier nicht weiter.
https://www.herber.de/bbs/user/99725.xlsm
Kann jemand helfen?
Danke euch!
Gruss Major

Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Major
Geschrieben am: 20.08.2015 16:38:42
sorry Makro ist nicht enthalten bei mir....

'Sub testmakro()
' testdateimakro Makro
'
'ActiveSheet.Range("C7:M7").Select
'neu:
'Dim sel As Range
'For Each sel In Selection
    'If sel.Value <= Date + 6 Then
      
        'Range(Cells(7, sel.Column), Cells(300, sel.Column)).Copy
        
        'Range(Cells(7, sel.Column), Cells(300, sel.Column)).Insert Shift:=xlToRight
        'Range(Cells(7, sel.Column), Cells(300, sel.Column)).PasteSpecial Paste:=xlValues'
        
        'Application.CutCopyMode = False
       
    'Else
    
    'End If
    
'Next
'End Sub


Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Matthias
Geschrieben am: 20.08.2015 17:10:58
Hallo Major,
etwa so? Kopier dir das bitte in den Code-Bereich von "Diese Arbeitsmappe", nicht ein Modul!

Sub Workbook_Open() 'beim Öffnen der Mappe
Dim Spalte As Long
'letzte Spalte ermitteln
Spalte = Cells(7, Columns.Count).End(xlToLeft).Column
'Wenn Datum der letzten Spalte <= Heute + 6 Dann
If Cells(7, Spalte).Value <= Date + 6 Then
    Cells(7, Spalte + 1) = Date + 6                                 'füge Heute +6 in Zeile 7  _
ein
    For x = 8 To 300                                                'für Zeile 8 bis 300
        Cells(x, Spalte).Copy Destination:=Cells(x, Spalte + 1)     'kopiere Zelle der letzten  _
Spalte in letzte Spalte +1
    Next x
End If
End Sub
lg Matthias

Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Major
Geschrieben am: 21.08.2015 09:06:43
Hi Matthias,
sieht schon mal ganz gut aus was du mir da gebastelt hast.
An dieser Stelle...

If Cells(7, Spalte).Value < Date + 6 Then

...musste ich das "=" bei "<=" entfernen, sonst wird bei jedem Öffnen rechts das Datum heute + 6 angefügt. Auch wenn ich mehrmals am Tag öffne, passiert dann der Schritt immer wieder.
Jetzt tritt halt der Fall ein den ich gemeint habe bezüglich...was wenn die Datei einen Tag oder mehrere nicht geöffnet wurde.
In der Beispieldatei...überspringt das Makro nun den 26.08.15, obwohl dieser genau so dargestellt werden soll.
https://www.herber.de/bbs/user/99745.xlsm
Ich glaube jetzt wirds richtig kompliziert :(

Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Matthias
Geschrieben am: 21.08.2015 09:54:29
Guten Morgen Major,
ahhh das hatte ich wohl falsch verstanden.
Hier dann also die korrigierte Variante:

Sub Workbook_Open() 'beim Öffnen der Mappe
Dim Spalte As Long
'letzte Spalte ermitteln
Spalte = Cells(7, Columns.Count).End(xlToLeft).Column
'Wenn Datum der letzten Spalte < Heute + 6 Dann
If Cells(7, Spalte).Value < Date + 6 Then
    i = Date + 6 - Cells(7, Spalte).Value 'Differenz zws. Heute+6 und letztem Datum
    For x = 1 To i  'wiederhole i-mal
        ' kopiere Zeilen 7 bis 300 und füge in Spalte rechts davon ein.
        Range(Cells(7, Spalte + x - 1), Cells(300, Spalte + x - 1)).Copy _
        Destination:=Range(Cells(7, Spalte + x), Cells(300, Spalte + x))
        ' Datum in Zeile 7 ändern
        Cells(7, Spalte + x).Value = Cells(7, Spalte + x - 1).Value + 1
    Next x
End If
End Sub
Kurz zur Erklärung:
Wenn das Datum in der letzten Spalte kleiner ist als Heute+6, dann bilde die Differenz zws. diesen beiden (i). Das Kopieren und Einfügen muss dann also für i Spalten ausgeführt werden.
Nun werden für jedes i Zeilen 7 bis 300 kopiert - ja auch das alte Datum damit die Formatierung übernommen wird - und anschließend das Datum um eins erhöht.
lg Matthias

Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Major
Geschrieben am: 21.08.2015 10:11:38
Hallo Matthias,
danke für die Erklärung...in der Theroie habe ich verstanden was passiert.
Habe den Code genauso eingefüght wie er da steht in die Beispieldatei.... nur passiert jetzt überhaupt nichts mehr. Keine neuen Splaten werden rechts angefügt.
Gruss Major

Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Matthias
Geschrieben am: 21.08.2015 13:46:48
Hallo Major,
denk bitte daran den Code nicht in ein Modul zu packen, sondern in "Diese Arbeitsmappe". Auch der Name des Makros "Workbook_Open()" ist wichtig. Habs nochmal getestet, bei mir funktioniert es.
Kann es sein, dass du ein anderes Tabellenblatt aktiv hattest beim Schließen der Datei? Wenn das Makro dann im falschen Blatt arbeitet ist das ungünstig. Bitte folgende Zeile unter "Dim Spalte As Long" einfügen.

Sheets("Tabelle1").Activate

Tabelle1 ist ist dabei der Name des Blattes in dem es aktiv sein soll.
lg Matthias

Bild

Betrifft: AW: Copy/Paste nach 2 Kriterien
von: Major
Geschrieben am: 21.08.2015 15:21:09
Hey Matthias,
habe einfach nochmal eine frische Datei gemacht und alles übernommen.
Nun ging es.
Danke dir jedenfalls dass du dir die Zeit genommen hast und wieder super erklärt!
Gruss Major

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Copy/Paste nach 2 Kriterien"