makroanpassen
04.12.2017 14:35:33
Werner
irgendwie kann ich scheinbar bei der Arbeit nicht antworten im Forum, oder ich bin grad zu blöd dazu (vermutlich letztes)
es geht darum das ich aus einer Tabelle Daten filtere per Makro und an in den nächsten Monat an entsprechender stelle kopiere. Tabellen 1-5, es wird gefiltert und den die Zeilen markiert und von Januar auf Februar etc. kopiert. das funktioniert soweit mit dem Makro. nun das Problem es gibt auch Daten welche kopiert werden müssen aber nicht in den folge Monat sondern in eine Jahresübersicht. Da hier nun die Daten aber immer weiter ansteigen funktioniert das nicht so wie bei vorherigen Makro. das Filtern schon, aber nicht das kopieren. da ja wenn ich im Februar das Makro starte, die Daten welche bei kopiert werden die des Januar überschreiben würden. das Makro brächte also einen Zusatz das es immer in die nächste freie Spalte schreiben soll. Durch die Filterung stehen auch immer nur die Daten noch in der Tabelle welche kopiert werden müssen. Kann man die Makros so anpassen das automatisch auch nur die angewählt werden, im Moment markiere ich den ganzen Bereich, also auch die Leerzeilen und kopiere alles, also ,markiere ich auch den ganzen Bereich in der Zieltabelle vorm kopiervorgang.
Daten aus Tabelle:
Clos. / MRSA / MRGN /Tbc / Sonstige
müssen entsprechend von Monat zu Monat übertragen werden und in eine Jahresübersicht
Daten sind:
Aufnahmenr /Station/Name/Geburtsdatum/Aufnahmedatum/IsoAnfang/Keim/IsoEnde/Bemerkung
sortiert wird durch Info ob IsoEnde (bzw. Pat entlassen ist), die Daten werden einfach durch den Filter gejagt und es bleiben dann nur die entsprechenden Datensätze übrig welche kopiert werden müssen.
für den Monatsübertrag kein Häkchen vorhanden / im folge Monat trage ich dann noch per Hand in eine Zeile (Übertrag aus Vormonat)ein X ein (Brauch ich damit in der Übersicht alles richtig berechnet wird) / hier sind die Daten immer einfach oben einzutragen, weitere werden dann im laufe des Monats drunter eingetragen
Für den Jahresübertrag ist automatisch ein Häkchen gesetzt / hier halt das Problem das sich da ja immer mehr Daten Sammeln und immer fortlaufen kopiert werden muss.
das Makro (für den Monatsübertrag) per Recorder aufgezeichnet:
Sub ÜbertragJanuar()
' ÜbertragJanuar Makro
Sheets("Clos.").Select
Range("A1:O30").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$32").AutoFilter Field:=15, Criteria1:="="
Range("A3:J30").Select
Selection.Copy
Windows("Februar.xlsm").Activate
Sheets("Clos.").Select
Range("A2:J30").Select
ActiveSheet.Paste
Windows("Januar.xlsm").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("MRSA").Select
Range("A1:O30").Select
Range("O30").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$32").AutoFilter Field:=15, Criteria1:="="
Range("A2:J30").Select
Selection.Copy
Windows("Februar.xlsm").Activate
Sheets("MRSA").Select
Range("A2:J30").Select
ActiveSheet.Paste
Windows("Januar.xlsm").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Range("P17").Select
Sheets("MRGN").Select
Range("A1:O30").Select
Range("O30").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$32").AutoFilter Field:=15, Criteria1:="="
Range("A3:J30").Select
Selection.Copy
Windows("Februar.xlsm").Activate
Sheets("MRGN").Select
Range("A2:J30").Select
ActiveSheet.Paste
Windows("Januar.xlsm").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Novo").Select
Range("A1:O30").Select
Range("O30").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$32").AutoFilter Field:=15, Criteria1:="="
Range("A2:J30").Select
Selection.Copy
Windows("Februar.xlsm").Activate
Sheets("Novo").Select
Range("A2:J30").Select
ActiveSheet.Paste
Windows("Januar.xlsm").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Tbc").Select
Range("A1:O30").Select
Range("O30").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$32").AutoFilter Field:=15, Criteria1:="="
Range("A3:J30").Select
Selection.Copy
Windows("Februar.xlsm").Activate
Sheets("Tbc").Select
Range("A2:J30").Select
ActiveSheet.Paste
Windows("Januar.xlsm").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Sonstiges").Select
Range("A1:O30").Select
Range("O30").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$O$32").AutoFilter Field:=15, Criteria1:="="
Range("A3:J30").Select
Selection.Copy
Windows("Februar.xlsm").Activate
Sheets("Sonstiges").Select
Range("A2:J30").Select
ActiveSheet.Paste
Windows("Januar.xlsm").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Eingabemaske").Select
End Sub
Danke für die Hilfe