PDA

Vollständige Version anzeigen : Zelle Datum prüfen dann einzelne Zellen kopieren


Golf 4 GTI
09.07.2014, 14:45
Hallo Zusammen,

ich komme hier nicht weiter. Folgendes Problem:

- Es sollen bei 2 Spalten AP & BB ab Zeile 5-144 das Datum geprüft werden
- Ist eins der beiden Datum's zum heutigen in Zukunft soll aus der gleichen Zeile die Zelle B, Z und die beiden Datums (AP & BB) in einen anderen Sheet kopiert werden.

Beispiel:

Heutiges Datum 09.07.2014
Datum Spalte AP5: 05.07.2014 (also nicht kopieren)
Datum Spalte BB5: 12.07.2014 (also doch kopieren)

Dann Kopieren von Sheet 1, die Zelle B5, Z5, AP5, BB55 zu Sheet 2 B5, C5, D5, E5

Wenn das Makro am 13.07.2014 erneut ausgeführt wird soll es wieder alle Zeilen im Sheet 1 prüfen und in Sheet 2 an die nächst freie Zeile kopieren. Zugleich sollte es im Sheet 2 die Zeilen löschen bei denen das Datum in Vergangenheit liegt. D.h. wenn das Makro am 13.07.2014 erneut ausgeführt wird muss im Sheet 2 die Zeile mit Datum 12.07.2014 wieder gelöscht werden.

Kann mir hier jemand helfen?

Danke.

Mc Santa
09.07.2014, 15:00
Hallo,

das geht prinzipiell über eine selbst programmiete Kopierfunktion.
Oder viel schneller über den Spezialfilter, den man automatisiert. Wenn du eine Beispieltabelle mit Layout und ein paar Beispieldaten bereitstellst, schreibe ich dir den Code dafür.

VG

Golf 4 GTI
09.07.2014, 15:14
Hallo,

Super Danke. Ich hab kurz eine Mustertabelle erstellt. Die richtigen Zeilen und Spalten kann ich dann hoffentlich selber anpassen wenn der Code funktioniert. Vielen Vielen Dank für deine Hilfe!!
Siehe Anahng.

Golf 4 GTI
09.07.2014, 15:47
Ich hab doch noch einmal eine andere Tabelle entworfen. So ist diese auch im Original.

Danke.

Mc Santa
09.07.2014, 16:01
:entsetzt: Verbundene Zellen!!

Das ist leider der Tod einer jeden Programmierung, könntest du darauf verzichten?

VG

Golf 4 GTI
09.07.2014, 16:04
Ja, ich mach einfach eine Hilfsspalte ohne verbundene Zellen die ich nur für dieses Marko nehme und blende diese dann aus. Oder gibt es dann Probleme wenn ich die Spalte ausblende? Danke

Neue Tabelle im Anhang

Mc Santa
09.07.2014, 16:10
Hm, ich weiß nicht ob das die Lösung ist..

Damit ein Filter richtig funktioniert, brauche ich untereinander stehende Daten mit einer eindeutigen Überschrift so wie es in deiner ersten Datei der Fall war.

Hier steht die Überschrift mal in Zelle B2-B4 und mal in Zelle AP4, damit kann ich leider nicht arbeiten :(

Am ehesten kommt eine Formellösung in Frage, vielleicht finde ich eine Möglichkeit, will aber nichts versprechen...

VG

EarlFred
09.07.2014, 16:13
Hallo Name?,

so (bezogen auf die 1. Datei!)?

Sub MakroStehtInEinemModul()

Worksheets("Tabelle3").Range("G1:H1").Value = Array("End Date CZ", "Ende Date WN")
Worksheets("Tabelle3").Range("G2,H3").Formula = "="">=""&TODAY()"


Worksheets("Tabelle1").Range("B3:E10").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Tabelle3").Range("B3:E3"), _
CriteriaRange:=Worksheets("Tabelle3").Range("G1:H3"), _
Unique:=False
End Sub

Grüße
EarlFred

Golf 4 GTI
09.07.2014, 16:16
Hallo,

habe die Überschrifften angepasst. Alle in einer Zelle und in Zeile 4

Grüße
Thomas

Golf 4 GTI
09.07.2014, 16:22
Hallo Name?,

so (bezogen auf die 1. Datei!)?

Sub MakroStehtInEinemModul()

Worksheets("Tabelle3").Range("G1:H1").Value = Array("End Date CZ", "Ende Date WN")
Worksheets("Tabelle3").Range("G2,H3").Formula = "="">=""&TODAY()"


Worksheets("Tabelle1").Range("B3:E10").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Tabelle3").Range("B3:E3"), _
CriteriaRange:=Worksheets("Tabelle3").Range("G1:H3"), _
Unique:=False
End Sub

Grüße
EarlFred


Für Tabelle 1 sollte das passen. Ich nehme meinen Notebook mal mit heim damit ich es gleich probieren kann. Kann man das auf meine letzte Tabelle "kopieren2.xlsm" auch anwenden? Danke.

Mc Santa
09.07.2014, 16:26
Leider nicht.

Du hast drei Zeilen (2 bis 4) mit Überschriften. Damit der Filter geht, darf es nur eine sein.

VG

Golf 4 GTI
09.07.2014, 16:53
Ich glaube ich weiß wie ich es mache. Ich erstelle ein neues Sheet und werde dort die Daten der 4 benötigten Spalten der Haupttabelle verknüpfen.
Einfach mit =Tabelle1!B5 usw... Dann kann ich ja die Tabelle im "Hilfsheet" genau so aufbauen wie in meiner ersten Tabelle. Mit der funktioniert ja dann die Formel. Wenn ich dann im Hauptsheet was ändere, ändert es sich ja automatisch auch im Hilfssheet und somit sollte es ja keine Probleme geben.

Bisschen umständig aber wird wohl funktionieren.

Die ganze Arbeitsmappe ist mit einem Login & Passwort versehen und je nach Benutzer öffnen sich unterschiedliche Sheets. Ich werde dann einfach den Hilfssheet nur für die Personen einblenden die es betrifft.

Golf 4 GTI
10.07.2014, 07:13
Eine Frage noch.
Wo muss ich den das Makro hinkopieren damit sich dieses beim Start der Arbeitsmappe automatisch startet und nicht erst durch ein Command Button zum laufen gebracht werden muss?

Danke

Hasso
10.07.2014, 07:59
Hallo Golf 4 GTI,

Unter Diese Arbeitsmappe:Option Explicit

Private Sub Workbook_Open()
Worksheets("Tabelle3").Range("G1:H1").Value = Array("End Date CZ", "Ende Date WN")
Worksheets("Tabelle3").Range("G2,H3").Formula = "="">=""&TODAY()"


Worksheets("Tabelle1").Range("B3:E10").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Tabelle3").Range("B3:E3"), _
CriteriaRange:=Worksheets("Tabelle3").Range("G1:H3"), _
Unique:=False
End Sub

Golf 4 GTI
10.07.2014, 09:20
Ah, Stimmt.
Die einfachsten Sachen sieht man nicht...

Golf 4 GTI
10.07.2014, 09:54
Letztes Problem und anscheinend ein gravierendes!

Eigentlich ist die Arbeitsmappe "freigegeben" damit mehr Leute gleichzeitig zugreifen können. Dann bekomme ich aber den Fehler:

Laufzeitfehler '1004':
Die AdvancedFilter-Methode des Range-Objektes konnte nicht ausgeführt werden

Wenn die Arbeitsmappe nicht freigegeben ist, funktioniert es.
Kann man das Problem noch lösen?

Mc Santa
10.07.2014, 09:57
Hallo,

gibt es das Problem unabhängig vom Speicherplatz?
Probiere es einmal in der Eigenen Dateien oder ähnliches, das hat bei mir schon einmal geholfen (auch wenn ich leider nicht genau sagen kann, warum. Ich vermute ein Berechtigungsproblem).

VG

Hasso
10.07.2014, 10:00
Hallo Golf 4 GTI,

guck dir mal diesen Beitrag an:Spezialfilter (Makro) in freigegebener Arbeitsmappe (http://www.ms-office-forum.net/forum/showthread.php?t=273126)

Golf 4 GTI
10.07.2014, 10:37
Es funktioniert!


Private Sub CommandButton2_Click()

Application.DisplayAlerts = False
If ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.ExclusiveAccess
End If

Worksheets("Freigabestatus").Range("W1:X1").Value = Array("End CZ", "End WN")
Worksheets("Freigabestatus").Range("W2,X3").Formula = "="">=""&TODAY()"

Worksheets("Current").Range("B3:F73").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Worksheets("Freigabestatus").Range("K11:O11"), _
CriteriaRange:=Worksheets("Freigabestatus").Range("W1:X3"), _
Unique:=False
Application.ScreenUpdating = True

If Not ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
End If
Application.DisplayAlerts = True

End Sub




Vielen, vielen Dank!