Sortieren, Kopieren, Schutz; Makro fuer alle
07.02.2006 18:30:04
Markus
Im Folgenden stelle ich der Allgemeinheit mein Makro zur Verfuegung.
Ich hab's nur mit eurer Hilfe und dem Recorder zusammengezimmert und es laeuft.
Schoen gell?!
Deshalb geize ich jetzt mal nicht mit gewonnenem Wissen und riskiere, dass ich mich blamiere...;-)
Aufgabe des Makros ist Folgendes:
Sortieren markierter Zeilen, uebernehmen von gewonnenen Berechnungen als neue Ausgangssituation, ueberschreiben der markierten Zeilen durch die nichtmarkierten und Schnittmengenabfragen als Schutz der Blattbereiche die durch den Anwender nicht veraendert werden sollen.
Ich weiss es ist wohl etwas holprig und vermutlich auch nicht sehr elegant, da es aber laeuft und ich blutiger Anfaenger in VBA bin, bin ichs zufrieden...:-)
Wer von den Profis Lust hat sich reinzudenken und evtl. Verbesserungen vorzuschlagen, nur zu, ich freue mich ueber Feedback und weitere Tipps!
Ansonsten noch mal Dank allen die mir geholfen haben!
Ciao,
Markus
Hier das Makro:
Sub CC_RipresaSaldo()
' CC_RipresaSaldo Macro
' Macro registrata il 06/02/2006 da MR
If Range("G10:G600").Text = "" Then 'Prueft ob Zellen leer sind, wenn leer kommt Meldung
MsgBox "Mettere spunta nelle celle G10:G600 e ORDINA prima!"
Exit Sub
End If ' wenn Zelle/Zellen markiert, laeuft das Makro
Set SMenge = Application.Intersect(Range("A11:G600"), Range(ActiveCell.Address)) 'Prueft ob aktuelle Zelle im Bereich liegt
If SMenge Is Nothing Then
MsgBox "Mettere cursore nelle celle A11:G600!" 'Meldung
Exit Sub
End If 'Wenn aktuelle Zelle im Bereich, startet Makro!
Application.ScreenUpdating = False
Range("A10:G600").Select
Range("G600").Activate
Selection.Sort Key1:=Range("G600"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("G65536").End(xlUp).Offset(0, 1).Select
Range("G65536").End(xlUp).Offset(0, 1).Select 'Letzte verwendete Zelle waehlen und Zelle Rechts aktivieren
Selection.Copy ' Kopieren der aktivierten Zelle
Range("H9").Select ' Zelle H9 aktivieren
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False 'Wert einfuegen
Range("G65536").End(xlUp).Offset(0, -6).Select 'Letzte verwendete Zelle waehlen und Zelle links (-6)aktivieren
Selection.Copy 'etc.
Range("A9").Select 'etc.
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("G65536").End(xlUp).Offset(1, -6).Select 'unterhalb der letzten markierten Reihe erste Zelle Spalte A aktivieren
Range(Selection, Selection.Offset(600, 6)).Copy ' Bereich bis Zeile 600 darunter kopieren
Range("A10").Select 'erste Anwender-Zelle aktivieren
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False ' Werte einfuegen
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub