Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Historie abspeichern
#1
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.


.xlsx   Historie.xlsx (Größe: 45,26 KB / Downloads: 6)
Antwortento top
#2
Hallo,
teste einmal. Bitte achte auf Sheets hat Endung: Historie.xlsm (!).


Angehängte Dateien
.xlsm   Historie.xlsm (Größe: 50,24 KB / Downloads: 1)
Grüße aus Nürnberg
Armin
Ich benutze WIN 10 (64bit) und Office 19 (64bit)
[-] Folgende(r) 1 Benutzer sagt Danke an EbyAS für diesen Beitrag:
  • StrammerMax
Antwortento top
#3
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?
Antwortento top
#4
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.




Zitat: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
Grüße aus Nürnberg
Armin
Ich benutze WIN 10 (64bit) und Office 19 (64bit)
[-] Folgende(r) 1 Benutzer sagt Danke an EbyAS für diesen Beitrag:
  • StrammerMax
Antwortento top
#5
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
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste