Selbststaendiges verschieben von Daten

[Christoph]

Liebes Forum,

ich arbeite derzeit an einer Excel, welche Kundenentwicklungen dokumentieren soll.

Diese Excel ist in 2 Sheets aufgeteilt. Im ersten Sheet sollen alle Kunden (jeder Kunde eine Zeile) oberflaechlich betrachtet werden. Ab einem Potential von sagen wir mal 300.000 sollen die Daten in ein zweites Sheet befoerdert werden, in welchem der Kunde dann eingehender betrachtet werden kann.

Dies sollte automatisiert ueber ein Makro erfolgen. Mittlerweile ist mein Code soweit, dass ich bei der Eingabe in ein bestimmtes Feld die vorhandenen Daten verschobene become.

Das ganze sieht folgendermassen aus:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
            If Not Intersect(Target, Range("K10:K100")) Is Nothing Then
            ActiveSheet.Unprotect "heute"
            Application.EnableEvents = False
            Target.Offset(0, 1) = Target.Offset(0, 1) + 1
            ActiveSheet.Protect "heute"
            If Intersect(Target, Range("Z10:Z101")) Is Nothing Then Exit Sub
            ActiveSheet.Unprotect "heute"
            With Sheets("Pipeline")
            Z = .Range("G1")
            .Range("G1") = .Range("AA1") + 1
            .Range("A" & Z) = Target.Value
            .Range("B" & Z) = Target.Offset(0, -20).Value
            .Range("C" & Z) = Target.Offset(0, -22).Value
        End With
    Application.EnableEvents = True
    ActiveSheet.Protect "heute"
End Sub

Da meine Kenntnisse in VBA noch recht mager sind komme ich derzeit nicht weiter.

Es fehlt mir noch, dass die Daten nur verschoben wenn in Feld Z ein Wert ueber 300.000 eingegeben wird. Ebenso gut waere es wenn sich die Felder im Ziel-Sheet bei einer Eingabe in das Quell-Sheet automatisch aktualisieren. Kann Excel das ueberhaupt leisten?

Ich bedanke mich im vorraus fuer Input!

Liebe Gruesse,

Christoph

[Rabe]

Hi Christoh,

Da meine Kenntnisse in VBA noch recht mager sind komme ich derzeit nicht weiter.

Es fehlt mir noch, dass die Daten nur verschoben wenn in Feld Z ein Wert ueber 300.000 eingegeben wird. Ebenso gut waere es wenn sich die Felder im Ziel-Sheet bei einer Eingabe in das Quell-Sheet automatisch aktualisieren. Kann Excel das ueberhaupt leisten?

so?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
    
    If Not Intersect(Target, Range("K10:K100")) Is Nothing Then
        ActiveSheet.Unprotect "heute"
        Application.EnableEvents = False
        Target.Offset(0, 1) = Target.Offset(0, 1) + 1
        ActiveSheet.Protect "heute"
    End If
    If Not Intersect(Target, Range("Z10:Z101")) Is Nothing Then
        ActiveSheet.Unprotect "heute"
        With Sheets("Pipeline")
            Z = .Range("G1")
            If Range("Z" & Z) = 300000 Then
                .Range("G1") = .Range("AA1") + 1
                .Range("A" & Z) = Target.Value
                .Range("B" & Z) = Target.Offset(0, -20).Value
                .Range("C" & Z) = Target.Offset(0, -22).Value
            End If
        End With
    End If
    Application.EnableEvents = True
    ActiveSheet.Protect "heute"
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

Wobei ich da nirgends sehe, daß etwas verschoben wird, sondern nur kopiert. Aber vielleicht liegt das auch an meinen Augen.

[Christoph]

Hallo Rabe,

so?
[...]
Wobei ich da nirgends sehe, daß etwas verschoben wird, sondern nur kopiert. Aber vielleicht liegt das auch an meinen Augen.

vielen Dank erstmal fuer die Antwort. Und als naechstes ein grosses Entschuldigung fuer die verspaetete Antwort. Ich war auf Reisen und laengere Zeit ohne Internetzugang.
Die Loesung funktioniert an sich. Allerdings bekomme ich so nur eine Verschiebung der Daten bei einer Gesamtsumme von 30000 pro Spalte. Ich braeuchte die Verschiebung aber bei einer Gesamtsumme von x =>300000 Ich habe den Code zwischenzeitlich selbst nochmals ein bisschen umgeschrieben da sich meine Anforderungen etwas "erweitert" haben.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
        If Not Intersect(Target, Range("K10:K100")) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(0, 1) = Target.Offset(0, 1) + 1
        ActiveSheet.Protect "heute"
        If Intersect(Target, Range("K10:K101")) Is Nothing Then Exit Sub
        ActiveSheet.Unprotect "heute"
        With Sheets("Pipeline")
        If Range("Z" & Z) = 300000 Then
            .Range("G1") = .Range("G1") + 1
            .Range("A" & Z) = Target.Value
            .Range("G" & Z) = Target.Offset(0, -3).Value
            .Range("F" & Z) = Target.Offset(0, -5).Value
            .Range("E" & Z) = Target.Offset(0, -6).Value
            .Range("D" & Z) = Target.Offset(0, -7).Value
            .Range("C" & Z) = Target.Offset(0, -8).Value
            .Range("B" & Z) = Target.Offset(0, -9).Value
            .Range("R" & Z) = Target.Offset(0, -1).Value
            .Range("R" & Z) = Target.Offset(0, 2).Value
            .Range("U" & Z) = Target.Offset(0, 3).Value
            .Range("V" & Z) = Target.Offset(0, 4).Value
            .Range("AB" & Z) = Target.Offset(0, 5).Value
            .Range("X" & Z) = Target.Offset(0, 4).Value
            .Range("W" & Z) = Target.Offset(0, 1).Value
            End With
        Application.EnableEvents = True
    End If
End Sub

Auch das hier ist allerdings noch weit vom Ziel entfernt. Ich habe jetzt mehrere Klienten denen mehrere Angebote unterbreitet werden. Beziffert sich die insgesamte Angebotssumme auf mehr als 300000 haette ich gerne die einzelnen Spalten in den verschiedenen Zeilen aufsummiert und in einer einzelnen Zeile im zweiten Sheet als Gesamt wiedergegeben.

Dies sollte am besten beim Speichern des Excel-Sheets geschehen.

Fuer mich viel zu hoch. Aber vielleicht gibt es ja einen geneigten Bastler. Oder einen Stoss in die richtige Richtung.

Vielen Dank auf jeden Fall schon im Voraus!

Viele Gruesse,

Christoph

[Rabe]

Hi Christoph,

Die Loesung funktioniert an sich. Allerdings bekomme ich so nur eine Verschiebung der Daten bei einer Gesamtsumme von 30000 pro Spalte. Ich braeuchte die Verschiebung aber bei einer Gesamtsumme von x =>300000 Ich habe den Code zwischenzeitlich selbst nochmals ein bisschen umgeschrieben da sich meine Anforderungen etwas "erweitert" haben.
[...]
Auch das hier ist allerdings noch weit vom Ziel entfernt. Ich habe jetzt mehrere Klienten denen mehrere Angebote unterbreitet werden. Beziffert sich die insgesamte Angebotssumme auf mehr als 300000 haette ich gerne die einzelnen Spalten in den verschiedenen Zeilen aufsummiert und in einer einzelnen Zeile im zweiten Sheet als Gesamt wiedergegeben.

Dies sollte am besten beim Speichern des Excel-Sheets geschehen.

Fuer mich viel zu hoch. Aber vielleicht gibt es ja einen geneigten Bastler. Oder einen Stoss in die richtige Richtung.

ich habe Dein Makro nochmal analog zum ersten Beispiel umgestrickt.

Die zweite If-Anweisung habe ich analog zur ersten geschrieben, so ist es besser nachzuvollziehen.
Du mußt aufpassen, daß ein If immer ein End If benötigt.
Aus der Zählvariablen Z habe ich loZ gemacht zur besseren Unterscheidung zur Spalte Z.
Für >= 300000 muß in der If-Abfrage einfach ein ">" eingefügt werden.

Weitere Fragen:

1. Wo wird der Variablen loZ eine Zahl zugewiesen?
   
2. Bist Du sicher, daß es in der zweiten IF-Abfrage K10:K101 und nicht Z (wie im Ursprungs-Makro) heißen soll?
   
3. Was steht in welchen Zellen?
   
4. Wo wird summiert?
   

An meiner selbstgebastelten Datei passiert nichts, also kann ich das Makro nicht testen. Es wäre gut, wenn wir eine Beispieldatei zur Verfügung hätten.

Zur Vorwarnung: Anstatt Screenshots ist eine Datei oder ein Ausschnitt besser!
"Du gehst ja auch nicht in die Werkstatt und gibst ein Foto Deines kaputten Autos ab!"

Also stelle bitte (D)eine (Beispiel-)Tabelle als Excel-Datei zur Verfügung oder stelle die relevanten Ausschnitte hier dar, siehe die als Wichtige Themen: markierten Forums-Beiträge.
Die farbigen Texte sind anklickbare Links:

Beitrag 1 WICHTIG: Tabellenausschnitte und VBA-Codes im Forum einstellen
Beitrag 2 WICHTIG: Arbeitsmappen zur Verfügung stellen


Hier der angepasste Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim loZ As Long
   
   If Not Intersect(Target, Range("K10:K100")) Is Nothing Then
       ActiveSheet.Unprotect "heute"
       Application.EnableEvents = False
       Target.Offset(0, 1) = Target.Offset(0, 1) + 1
       ActiveSheet.Protect "heute"
   End If
   
   If Not Intersect(Target, Range("K10:K101")) Is Nothing Then      'bist Du sicher, daß es hier K und nicht Z heißen soll? 
       ActiveSheet.Unprotect "heute"
       With Sheets("Pipeline")
           If Range("Z" & loZ) >= 300000 Then
               .Range("G1") = .Range("G1") + 1
               .Range("A" & loZ) = Target.Value
               .Range("G" & loZ) = Target.Offset(0, -3).Value
               .Range("F" & loZ) = Target.Offset(0, -5).Value
               .Range("E" & loZ) = Target.Offset(0, -6).Value
               .Range("D" & loZ) = Target.Offset(0, -7).Value
               .Range("C" & loZ) = Target.Offset(0, -8).Value
               .Range("B" & loZ) = Target.Offset(0, -9).Value
               .Range("R" & loZ) = Target.Offset(0, -1).Value
               .Range("R" & loZ) = Target.Offset(0, 2).Value
               .Range("U" & loZ) = Target.Offset(0, 3).Value
               .Range("V" & loZ) = Target.Offset(0, 4).Value
               .Range("AB" & loZ) = Target.Offset(0, 5).Value
               .Range("X" & loZ) = Target.Offset(0, 4).Value
               .Range("W" & loZ) = Target.Offset(0, 1).Value
           End If
       End With
   End If
   Application.EnableEvents = True
   ActiveSheet.Protect "heute"
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

Und es gilt weiterhin aus meiner ersten Antwort:

Wobei ich da nirgends sehe, daß etwas verschoben wird, sondern nur kopiert. Aber vielleicht liegt das auch an meinen Augen.