Historie abspeichern

[StrammerMax]

Hallo zusammen,

ich habe hier eine Datei mit einem Sheet auf dem immer die aktuellen Werte in einer kleinen Liste angezeigt werden. 
Diese Werte können sich aber täglich ändern, da die Datenbasis sich immer wieder ändert.

Um den Verlauf zu sehen braucht man eine Möglichkeit eine Historie zu bilden. 

Ich habe mir überlegt, dass es neben der Übersicht einen Button "Speichern" gibt. 
Wenn man auf den Button klickt soll der Ausschnitt der Daten auf ein Blatt "Historie" als feste Werte gespeichert werden mit dem aktuellen Tagesdatum als Überschrift. 

Jedes Mal wenn man den Button zum speichern drückt soll der Datenbereich unter der letzten Sicherung im Blatt Historie abgespeichert werden - quasi mit unendlicher Schleife immer mit X-Zeilen Abstand zur letzten Sicherung.


  Historie.xlsx (Größe: 45,26 KB / Downloads: 7)

[EbyAS]

Hallo,
teste einmal. Bitte achte auf Sheets hat Endung: Historie.xlsm (!).

[StrammerMax]

Hallo EbyAS,

vielen Dank für deine Hilfe. Das sieht in der Beispieldatei genau so aus wie es sein soll. 

Allerdings bekomme ich es bei mir nicht so recht implementiert.

   

Ich habe grundlegend 3 Probleme:
1. er übernimmt die Werte nicht (als harte Werte)
2. er übernimmt in Spalte N und R die Buttons (sollen nicht übernommen werden)
3.  er kopiert nur ein mal in die History und führt nicht nach unten die neuen Stände weiter. 

Zu 1. 
Die Werte in der Ausgangstabelle kommen aus Pivottabellen. In der Historie bekomme ich dann entweder nur komplett leere Zellen angezeigt oder #Bezug. 
Die Werte müssen hart "als Werte" kopiert werden, damit sie sich in der Historie nicht mehr ändern können - egal was in der Ursprungstabelle passiert. 

Zu 2. 
Ich weiß nicht so recht wie man die Buttons vom Kopieren ausnehmen könnte

Zu 3. 
Ist sicher nur eine falsche Einstellung am Code

Code:

Option Explicit

Sub Kopiere()
Dim M As Integer
Dim K As Integer
Dim WU As Worksheet
Dim N As Integer
Dim WHIS As Worksheet

Set WU = ActiveWorkbook.Worksheets("Uebersicht")
Set WHIS = ActiveWorkbook.Worksheets("History")
N = WHIS.Cells(Rows.Count, 1).End(xlUp).Row / 10
M = 10 * N + 1
WU.Cells(44, 1).Resize(14, 22).Copy Destination:=WHIS.Cells(M, 1)
WHIS.Cells(M, 1).ClearComments
End Sub

Könntest du mir da evtl. nochmal helfen?

[EbyAS]

Hallo,

warum in aller Welt müssen wir immer Hellseher sein. Von Button war keine Rede in Deinem Muster.


Wenn man das so bekommt kopieren wahrscheinlich die meiseten den Berich komplett.


So kann man nur die Bereiche einzeln speichern. Button kannst Du zwar beim Drucken ausblenden aber nicht beim kopieren.

Oder man kopiert alles und entfernt im nachhinein die Buttons.

Ich habe grundlegend 3 Probleme:
1. er übernimmt die Werte nicht (als harte Werte)
2. er übernimmt in Spalte N und R die Buttons (sollen nicht übernommen werden)
3.  er kopiert nur ein mal in die History und führt nicht nach unten die neuen Stände weiter. Stimmt nicht, bedienfehler es wird bei jedem rechten Maus-Click in Zelle A1 eine Kopie erzeugt.

Ob Du den rechten Maus-Click belässt oder einen Button dafür benutzt, ist völlig gleich. Bei jedem ausführen des Codes  "Kopiere" werden die Zellen aus dem Bereich A1-D7 & F2-F7 & H2-J7 in Tabelle "Historie" angehängt.

Diesen Code in das Modul speichern das ich Dir schon geschickt hatte und den alten Code löschen.

Den Code:

Code:

Sub Kopiere()
Dim M As Integer
Dim K As Integer
Dim WU As Worksheet
Dim N As Integer
Dim WHIS As Worksheet

Set WU = ActiveWorkbook.Worksheets("Uebersicht")
Set WHIS = ActiveWorkbook.Worksheets("Historie")
N = WHIS.Cells(Rows.Count, 1).End(xlUp).Row / 10
M = 10 * N + 1
WU.Cells(1, 1).Resize(7, 4).Copy
With WHIS.Cells(M, 1)
    .PasteSpecial Paste:=xlValues      ' Werte
    .PasteSpecial Paste:=xlFormats     ' Formate
End With

WU.Cells(2, 6).Resize(6, 1).Copy
With WHIS.Cells(M + 1, 6)
    .PasteSpecial Paste:=xlValues      ' Werte
    .PasteSpecial Paste:=xlFormats     ' Formate
End With

WU.Cells(2, 8).Resize(6, 3).Copy
With WHIS.Cells(M + 1, 8)
    .PasteSpecial Paste:=xlValues      ' Werte
    .PasteSpecial Paste:=xlFormats     ' Formate
End With
Application.CutCopyMode = False
End Sub

[StrammerMax]

Perfekt, vielen Dank. 

Es waren zwar noch einige Anpassungen bzgl. der angesprochenen Zeilen und Spalten nötig, aber die habe ich so hinbekommen. 

Code:

Sub Kopiere()

Application.ScreenUpdating = False

Dim M As Integer
Dim K As Integer
Dim WU As Worksheet
Dim N As Integer
Dim WHIS As Worksheet

Set WU = ActiveWorkbook.Worksheets("Uebersicht")
Set WHIS = ActiveWorkbook.Worksheets("History")
N = WHIS.Cells(Rows.Count, 1).End(xlUp).Row / 10
M = 10 * N + 3
WU.Cells(43, 2).Resize(15, 11).Copy
With WHIS.Cells(M, 1)
    .PasteSpecial Paste:=xlValues      ' Werte
    .PasteSpecial Paste:=xlFormats    ' Formate
End With

WU.Cells(43, 15).Resize(15, 3).Copy
With WHIS.Cells(M, 13)
    .PasteSpecial Paste:=xlValues      ' Werte
    .PasteSpecial Paste:=xlFormats    ' Formate
End With

WU.Cells(43, 19).Resize(15, 4).Copy
With WHIS.Cells(M, 17)
    .PasteSpecial Paste:=xlValues      ' Werte
    .PasteSpecial Paste:=xlFormats    ' Formate
End With
Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub