✔ Inhalt der Zelle einer Variablen zuweisen

Das ist ja nicht mehr schwer hinzukriegen...
Anderseits.... der Code muss stehen bleiben bis zum nächsten Klick. Lassmich mal kurz was probieren
 
So müsste es gehen. Ist eigentlich keine Hexerei
Visual Basic: 
Option Explicit

Dim flagInProcess As Boolean    'Flag, ob wir gerade imProzess sind
Dim srcRng As Range             'Quellrange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim rowDelta As Integer

    'Nur ausführen, wenn wir gerade nicht im Copy-Process sind
    If Not flagInProcess Then
        'Nur reagieren wenn wir im Range A1-B43 sind. Ansonste hier die Methode verlassen
        If Target.Row > 43 Or Target.Column > 2 Then Exit Sub
        'Markeiren, dass wir im C&P Modus sind
        flagInProcess = True
        'Quellrange auslesen
        Set srcRng = Range(Cells(Target.Row, 1), Cells(Target.Row, 2))
        MsgBox "Ausgewählte Werte: " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
    'Ausführen, wenn wir im
   
    'Wir sind am Kopieren aber ausserhalb des Zielbereiches
    ElseIf Intersect(Range("I11:J33"), Target) Is Nothing Then
        'Nachfragen um abzubrechen
        flagInProcess = MsgBox("Feld ist nicht im Zielbereich. Weiter kopieren?", vbCritical + vbOKCancel) = vbOK

    'Target im Ziel
    Else
        'Werte Kopieren
        srcRng.Copy Range("I" & Target.Row & ":J" & Target.Row)
        'Nachfragen ob weiter kopiert werden soll
        flagInProcess = MsgBox("Kopiere den Wert nochmals?", vbQuestion + vbOKCancel) = vbOK
        'Falls fertig, sauber aufräumen
        If Not flagInProcess Then Set srcRng = Nothing
    End If
   
End Sub
 
Schön! Könnte man den Range von A1-B43 mit C1-D43 und E1-F43 erweitern ? Das wäre Super!
Es sind die letzen 20% von meinem Projekt die ich ohne Hilfe nicht geschafft hätte!
 
Jetzt ist der Moment zu lernen. Eine gute Sache, das selber zu erweitern. Ich beantworte gerne Fragen. Aber die Lösung musst du selber finden.
 
Ja, ich versuche es! Ich probiere es zu vereinfachen, weil es hat viel zu viele MsgBoxen. Ich muss mich nicht auf die Copy-Bereiche beschränken, die sin sowieso ausgefüllt und wenn man außerhalb des Copy-Bereichs klickt, wird eine leere Zelle kopiert. Langsam verstehe ich die Befehle, und Ich hoffe das ich ein Erfolg haben werde.
 
Nun habe ich den VBA-Code nach meinem Gusto angepasst. Was mir fehlt, ist die Copy-Bedingung für die Spalten I und J.
Ist da noch was zu machen?
Viele Dank!

Option Explicit

Dim flagInProcess As Boolean 'Flag, ob wir gerade imProzess sind
Dim srcRng As Range 'Quellrange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not flagInProcess Then
flagInProcess = True
If Target.Column = 1 Or Target.Column = 2 Then
Set srcRng = Range(Cells(Target.Row, 1), Cells(Target.Row, 2))
MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
End If
If Target.Column = 3 Or Target.Column = 4 Then
Set srcRng = Range(Cells(Target.Row, 3), Cells(Target.Row, 4))
MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
End If
If Target.Column = 5 Or Target.Column = 6 Then
Set srcRng = Range(Cells(Target.Row, 5), Cells(Target.Row, 6))
MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
End If
ElseIf Intersect(Range("G11:J33"), Target) Is Nothing Then
flagInProcess = MsgBox("Eingabe beenden?", vbCritical + vbOKCancel) = vbOK
'Dies ist der Copy-Bereich für Spalte G und H
Else: srcRng.Copy Range("G" & Target.Row & ":H" & Target.Row)
'
If Not flagInProcess Then Set srcRng = Nothing
flagInProcess = False
End If
End Sub
 
Option Explicit

Dim flagInProcess As Boolean 'Flag, ob wir gerade imProzess sind
Dim srcRng As Range 'Quellrange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not flagInProcess Then
flagInProcess = True
If Target.Column = 1 Or Target.Column = 2 Then
Set srcRng = Range(Cells(Target.Row, 1), Cells(Target.Row, 2))
MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
End If
If Target.Column = 3 Or Target.Column = 4 Then
Set srcRng = Range(Cells(Target.Row, 3), Cells(Target.Row, 4))
MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
End If
If Target.Column = 5 Or Target.Column = 6 Then
Set srcRng = Range(Cells(Target.Row, 5), Cells(Target.Row, 6))
MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
End If
ElseIf Intersect(Range("G11:J33"), Target) Is Nothing Then

'Die folgende Zeile funktioniert nicht mehr...
flagInProcess = MsgBox("Eingabe beenden?", vbCritical + vbOKCancel) = vbOK

'Dies ist der Copy-Bereich für Spalte G und H
Else: srcRng.Copy Range("G" & Target.Row & ":H" & Target.Row)
'
If Not flagInProcess Then Set srcRng = Nothing
End If

End Sub
 
Zuletzt bearbeitet:
Visual Basic: 
Option Explicit

Dim flagInProcess As Boolean    'Flag, ob wir gerade imProzess sind
Dim srcRng As Range             'Quellrange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not flagInProcess Then
       flagInProcess = True
        If Target.Column = 1 Or Target.Column = 2 Then
          Set srcRng = Range(Cells(Target.Row, 1), Cells(Target.Row, 2))
          MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
        End If
        If Target.Column = 3 Or Target.Column = 4 Then
          Set srcRng = Range(Cells(Target.Row, 3), Cells(Target.Row, 4))
          MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
         End If
          If Target.Column = 5 Or Target.Column = 6 Then
            Set srcRng = Range(Cells(Target.Row, 5), Cells(Target.Row, 6))
            MsgBox "Ausgewähltes Lied : " & srcRng.Cells(1, 1).Value & " & " & srcRng.Cells(1, 2).Value, vbInformation + vbOKOnly
          End If
    ElseIf Intersect(Range("G11:J33"), Target) Is Nothing Then
  
    'Die folgende Zeile funktioniert nicht mehr, muss ich hier den Befehl flaginProcess = Else setzen?
        flagInProcess = MsgBox("Eingabe beenden?", vbCritical + vbOKCancel) = vbOK
      
        'Dies ist der Copy-Bereich für Spalte G und H
    Else: srcRng.Copy Range("G" & Target.Row & ":H" & Target.Row)
    '
       If Not flagInProcess Then Set srcRng = Nothing
    End If
    
End Sub
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück