Office: (Office 365) VBA Zellbereiche (Zeilen) verschieben

Hallo Ihr Lieben, ich suche seit Tagen nach einem funktionierenden VBA-Code, aber keiner will so wie ich will. Immer kommen Fehlermeldungen. Deshalb hoffe ich, hier eine funktionierende Lösung zu finden. :-) Danke schon mal für Eure Mühe.

Vorabinfo:
(siehe Bild Tabelle.png)
Ich habe eine Tabelle "Offen" von Spalte A bis Spalte N; Zeilen 1 bis 4 sind Kopfzeilen. Ab Zeile 5 beginnen die Eintragungen. In Spalte N wird durch Formeln ermittelt, ob der Fall erledigt ist. Wenn ja, dann wird in N "erl" hinterlegt.
Am Ende der Woche werden neue Listeneinträge mit den bestehenden verglichen.

Nun die Aufgabe des Scrips:
Jene Zeilen (bzw. Bereiche von A bis N), bei denen in N ein "erl" steht, sollen nur per Knopfdruck in das Blatt "Erledigt" VERSCHOBEN werden - mit Formatierungen und Formeln. In Blatt "Offen" sollen dann auch die ganzen Zeilen gelöscht werden - also auch keine Leerzeilen bleiben.
Meine Excel liegt als Offene_Faelle.xlsm in einer Cloud, nicht lokal.

Ich habe einen Code einer vergleichbaren Frage kopiert und meinen Spalten angepasst, aber klappt nicht :-/ Excel beglückt mich beim Ausführen des Makros mit der Fehlermeldung: Fehler beim Kompilieren: Unzulässige Verwendung des Schlüsselwortes Me (Zeile 4 meines Scripts).
(siehe Bild Fehlermeldung.png)

Sub BedingteKopieZeilen()
Dim lnglast As Long
Dim c As Range, rngDel As Range
lnglast =<b> Me.</b>Cells(rows.Count, "N").End(xlUp).row
If Not Intersect(Target, Range("N5:N" & lnglast)) Is Nothing Then
Application.EnableEvents = False
For Each c In Intersect(Target, Range("N5:N" & lnglast))
If LCase(c.Value) = "erl" Then
With Worksheets("Erledigte")
c.EntireRow.Copy _
Destination:=.Cells(.Cells(rows.Count, "N").End(xlUp).row + 1, 1)
If rngDel Is Nothing Then
Set rngDel = c
Else
Set rngDel = Union(c, rngDel)
End If
End With
End If
Next c
rngDel.EntireRow.Delete
Application.EnableEvents = True
End If
End Sub

Kann mir Jemand mein Script so korrigieren, dass es funktioniert und mir vielleicht kurz erklären, warum die Fehlermeldung kam?
Danke und nette Grüße
Felizia

 

Hallo Felizia,
mindestens zwei Dinge gehen nicht:
1. Das Schlüsselwort Me verweist auf das Objekt einer Userform, die Konstruktion Me.Cells(... kann es also nicht geben. Was Du damit wirklich ansprechen willst, habe ich nicht ergründet.
2. Target ist eine Variable, die vom System bei Ereignisroutinen (SelectionChange, Change) an die entsprechende Routine übergeben wird und die aktive/n) Zelle(n) repräsentiert. In Deiner Routine kann es Target nicht geben geben
Was sonst noch nicht stimmt, könnte man evtl. ermitteln, wenn Du die Datei nicht als Bild, sondern als Datei postest.
Gruß der ALteDresdner

 

Hallo Felizia,

wie schon AlterDresdner erwähnt hat, sind die beiden Wörter "Me" bzw. "Target" hier fehl am Platz.

So wie es aussieht, hast du den Prozedurinhalt aus einer Ereignisbehandlungsroutine kopiert. Diese befindet sich entweder im Codemodul der Arbeitsmappe ("DieseArbeitsmappe" bzw. englisch "ThisWorkbook") oder aber in einem Codemodul eines Arbeitsblattes.

Dort bezieht sich sich das "Me" als Objektinstanzzeiger entweder auf die Arbeitsmappe oder auf das Arbeitsblatt, zu dem das Codemodul gehört. Ebenso könnte es ein Objektinstanzzeiger im Codemodul einer Userform auf diese Userform-Instanz sein.

Diese Kopie hast du dann in ein allgemeines Codemodul eingefügt. Dort ist aber beides unbekannt - deshalb die Compiletime-Fehlermeldung.

Vermutlich wirst du statt "Me.Cells(....)" schreiben müssen:
entweder ActiveSheet.Cells(....)
oder Worksheets("Blattname").Cells(...)
wobei "Blattname" die Bezeichnung ist, die im Arbeitsblatttabulator steht.

Vermutlich wirst du statt "Intersect(Target, Range("N5:N" & lnglast))" schreiben müssen:
entweder: ActiveSheet.Range("N5:N" & lnglast)
oder Worksheets("Blattname").Range("N5:N" & lnglast)
und zwar an beiden Codestellen. Damit beziehst du dich auf die Zellen des verwendeten Zellbereichs in Spalte N.
In der Zeile "For Each c ..." wäre es auch günstig, wenn du noch ".Cells" anfügen würdest, also z.B.
ActiveSheet.Range("N5:N" & lnglast).Cells oder Worksheets("Blattname").Range("N5:N" & lnglast).Cells

 

@AlterDresdner : Hallöchen lieber Landsmann, erst einmal danke für Deine Aufklärung :-) ich habs verstanden :-)
@Exl121150 : Dir auch lieben Dank, ich werde zuerst einmal ausprobieren, was das Script sagt, wenn ich die Zeilen entsprechend Deiner Vorschläge ändere. Learning by doing :-)

 

... ich bekomme es leider nicht hin ich habe (noch) keinerlei Ahnung von der Syntax in VBA.

Ich habe deshalb jetzt eine vereinfachte und gekürzte Version meiner Arbeitsmappe hochgeladen. Die Tabelle ist im Original zwischen 8000 und 12000 Zeilen groß (schwankt von Woche zu Woche) und geht im Original bis Spalte BB (entspricht N in dieser kleinen Version). Deshalb - und um schneller begreifen zu können wie VBA funktioniert, wäre mir ganz Recht, wenn Arbeitsblätter und Spalten mit Namen benannt werden.

Herzlichen Dank schon mal! :-)
Felizia

 

Hallo Felizia,

in deiner Datei war ja überhaupt kein Makro enthalten.
Ich habe für Testzwecke dein Originalarbeitsblatt "Offene_Fälle" kopiert ins Arbeitsblatt "Offene_Fälle (2)".
Ferner habe ich in beiden Arbeitsblättern den blauen Button "Erledigte Zeilen verschieben" eingefügt, der mit folgendem Makro im allgemeinen Codemodul "Modul1" verknüpft ist:

Code:

Option Explicit

Sub BedingteKopieZeilen()
   Dim Ws As Worksheet
   Dim lnglast As Long
   Dim c As Range, rngDel As Range
  
   Set Ws = ActiveSheet
   lnglast = Ws.Cells(Rows.Count, "N").End(xlUp).Row
   If Not Ws.Range("N5:N" & lnglast) Is Nothing Then
      On Error GoTo Exit_BedKopie
      Application.EnableEvents = False
      For Each c In Ws.Range("N5:N" & lnglast).Cells
         If LCase(c.Value) = "erl" Then
            With Worksheets("Erledigte")
               c.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "N").End(xlUp).Row + 1, 1)
               If rngDel Is Nothing Then
                  Set rngDel = c
               Else
                  Set rngDel = Union(c, rngDel)
               End If
            End With
         End If
      Next c
      rngDel.EntireRow.Delete
Exit_BedKopie:
      Application.EnableEvents = True
   End If
End Sub

Im Arbeitsblatt "Erledigt" musst du in Zeile 1 eine Kopfzeile einfügen, aber das wirst ja schaffen.
Ferner habe ich - außer den bereits beschriebenen Änderungen im vorigen Posting - eine Fehlerbehandlung eingefügt. Denn im Fall, dass kein Satz verschoben werden müsste, würde ein Runtime-Fehler in der Zeile "rngDel.EntireRow.Delete" entstehen.

Ergänzte Datei liegt bei.

 

OMG das ist ja genial! Ich habe es soeben probiert - das funktioniert 1A! Vielen vielen Dank, Anton :-) Jetzt bin ich richtig motiviert, mir die Grundlagen von Visual Basic anzueignen. Das hebt Office ja auf ein ganz anderes Niveau der Möglichkeiten!

Nochmals DANKE

 

@Exl121150
Hallöchen Anton,
Dein Code (siehe oben) funktioniert wunderbar! Ich benutze ihn, um bei einem Fall einen Zeitstempel per Kürzel in die danebenliegende Zelle zu generieren. Jetzt habe ich mehrere Fälle von ein und demselben Kunden. Wenn ich das erste Kürzel und den ersten Zeitstempel kopiere und bei allen anderen Fällen des Kunden eintrage, bekomme ich verständlicherweise eine Fehlermeldung. Gibt es auch eine Möglichkeit, diese Fehlermeldung per Einbau eines Codes zu unterdrücken, sodass ich immer nur einen Zeitstempel per Kürzel in der Nachbarzelle generieren lassen muss und diesen dann für alle weiteren Zeilen kopieren und einfügen kann, ohne jedes Mal die Fehlermeldung wegklicken zu müssen?

Danke schon mal im Voraus :-)

 

Hallo Felizia "die Glückliche",

du verwirrst mich, denn mein obiger VBA-Code generiert keinen Zeitstempel, sondern verschiebt Sätze (Zeilen) in ein anderes Arbeitsblatt. Deine Beschreibung hört sich jedoch so an, als ob du eine Funktion/Formel in einer daneben liegenden Zelle benötigst.
Ich helfe dir gerne weiter - dazu müsste ich allerdings die Details zu dieser Funktion kennen.

 

ui ui ... da ist mir ein Irrläufer untergekommen. :-D

Hier der Code, der einen Zeitstempel in der Nachbarzelle meiner Kürzel-Zelle generiert und eine Debug-Meldung bringt, sobald man den Zeitstempel und das Kürzel kopiert und bei anderen Zeilen einfügt (weil das bei 20 Zeilen schneller geht als bei jeder einzelnen das Kürzel einzutragen):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("R3:R8000,U3:U8000,X3:X8000,AM3:AM8000,AP3:AP8000,AS3:AS8000")) Is Nothing Then
With Target
If .Value = "" Then
.Offset(, -1).ClearContents
Else
.Offset(, -1).Value = Format(Now, "dd.mm.yyyy hh:mm:ss")
End If
End With
End If
End Sub

Ich glaube, irgendwo muss " On Error Resume Next " ?

 

Hallo,

nachfolgend deine modifizierte Callback-Prozedur für das Change-Ereignis des dazugehörigen Arbeitsblattes:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Zelle As Range
 
   If Not Intersect(Target, Range("R3:R8000,U3:U8000,X3:X8000,AM3:AM8000,AP3:AP8000,AS3:AS8000")) Is Nothing Then
 
      On Error GoTo Exit_WsChange
      Application.EnableEvents = False
  
      For Each Zelle In Target.Cells
         With Zelle
            If .Value = "" Then
               .Offset(, -1).ClearContents
            Else
               .Offset(, -1).Value = Format(Now, "dd.mm.yyyy hh:mm:ss")
            End If
         End With
      Next Zelle
  
Exit_WsChange:
      Application.EnableEvents = True
  
   End If
End Sub

Warum es zu der Error-Meldung kam, kann an zweierlei Umständen liegen:

Der erste Umstand ist, dass die beiden folgenden Zeilen nicht enthalten waren:
Application.EnableEvents = False
Application.EnableEvents = True
Es ist fast immer ratsam, diese beiden Zeilen bei der Behandlung des Change-Events zu verwenden. Denn falls nicht vorhanden, heißt das, dass das Change-Event bei Zellwertänderung stets eintritt. Sobald also dann innerhalb des Makros eine Zelländerung im Arbeitsblatt veranlasst wird, wird somit ebenfalls ein Change-Event ausgelöst, was zum sofortigen Aufruf des noch nicht beendeten Makros führt ==> Die Folge ist ein sogenannter "Circulus vitiosus" (=eine rekursive Endlosschleife), was zu einem Absturz der Arbeitsmappe bzw. auch von Excel selbst führen kann.
Ich habe wie gewünscht das Error-Handling eingebaut: Es besteht in den beiden Zeilen:
On Error GoTo Exit_WsChange
Exit_WsChange:
Tritt also innerhalb der Change-Prozedur ein Fehler auf, so muss gewährleistet sein, dass bei Beendigung der Prozedur die Event-Behandlung wieder eingeschaltet ist. Deshalb ist die Sprungmarke "Exit_WsChange:" vor der Anweisung "Application.EnableEvents = True" zu platzieren, damit die Excel-Events beim Verlassen der SUB garantiert wieder funktionieren.

Der zweite Umstand liegt in folgender Erklärung:
1) Die vorgenannte Prozedur wird von Excel jedesmal aufgerufen, wenn im dazugehörigen Arbeitsblatt eine Änderung in einer Zelle bzw. in einem Zellbereich aufgrund einer Tastatur/Maus-Eingabe stattfand. Mit "Target" wird dabei die Zelle bzw. der Zellbereich der Änderung übergeben.
2) Dann testet das Makro, ob es sich dabei um Zelle(n) aus dem Zellbereich "R3:R8000" oder "U3:U8000" usw. handelt. Falls ja, wird der folgende IF-Block ausgeführt; Falls nein, wird das Makro verlassen.
3) Falls also 2) zutrifft, werden die folgenden Zeilen ausgeführt, d.h. es wird der Zellinhalt links neben der Änderungszelle geändert (entweder wird ihr Inhalt gelöscht oder aber es wird der Zeitstempel deponiert). Das war die Szenerie, die dein Makro beherrschte.
4) Was Punkt 3) betrifft, habe ich dein Makro erweitert dahingehend, dass Punkt 3) jetzt für einen Zellbereich funktioniert, indem für jede Zelle dieses Bereiches Punkt 3) ausgeführt wird. Dagegen erzeugte dein bisheriges Makro einen Fehler, wenn Target aus mehr als 1 Zelle bestand.

 

@Exl121150
Hallo Anton,
vielen herzlichen Dank! Du hast Dir ja richtig viel Mühe gemacht mit Deiner Erklärung. Das ist mir sehr viel Wert, denn dadurch lerne ich schneller die Syntax zu verstehen und selbst anzuwenden.

Hab einen schönen Sonntag und bleib gesund. :-)

LG Felizia

 

@Exl121150
Jetzt hab ich nur das Problem, dass beim Kopieren auch die Zelle -2 mit einem Datum gefüllt wird. Ich habe mal eine Testdatei mit angehängt.
Kopiere mal Zellen I-J 7 (Datum und Kürzel FS) und füge es eine Zeile weiter unten ein. Da wird die Spalte mit den Telefonnummern überschrieben, was ja nicht sein soll.

Liebe Grüße
Felizia :-)

 

Hallo,

ich habe dir jetzt statt der Codezeile
If Not Intersect(Target, Range("J3:J300,U3:U300")) Is Nothing Then
folgende Zeile eingefügt:
If SindZellenInBereichen(Target, "J3:J300,U3:U300") Then
Diese Zeile ruft die nachfolgende benutzerdefinierte Funktion auf, die überprüft, ob Target in einem der aufgelisteten Zellbereiche zur Gänze enthalten ist.

Code:

Private Function SindZellenInBereichen(Zellen As Range, Bereiche As String) As Boolean
  Dim Bereich As Variant
  Dim L As Long, T As Long, R As Long, B As Long
 
  With Zellen
    L = .Column: T = .Row
    R = L + .Columns.Count - 1: B = T + .Rows.Count - 1
  End With
 
  SindZellenInBereichen = False
  On Error GoTo Exit_ZellenIB
 
  For Each Bereich In Split(Bereiche, ",")
     With Range(Bereich)
        If .Row <= T And .Column <= L Then
           If .Row + .Rows.Count - 1 >= B And R <= .Column + .Columns.Count - 1 Then
              SindZellenInBereichen = True
              Exit Function
           End If
        End If
     End With
  Next Bereich
Exit_ZellenIB:
End Function

 

@Exl121150
Hallo Anton, danke für Deine Mühe, aber jetzt funktioniert der Zeitstempel in Spalte I durch Auswahl eines Kürzels in Spalte J (SIGN) überhaupt nicht mehr.

Gibts nicht eine Möglichkeit, in meinen Code einzuarbeiten, dass beim Kopieren von Zeitstempel und Signatur keine Debug-Meldung angezeigt wird?

Hier noch mal mein Code, der einwandfrei funktioniert hat: