Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1728to1732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

MsgBox

MsgBox
20.12.2019 07:59:12
Stefan
Hallo Liebe Experten,
Ich kopiere mit einem Doppelklick mit folgendem Code eine Reihe in eine andere Mappe.
Wie bekomme ich es hin das nach dem Doppelklick erst eine MsgBox kommt und ich nochmal bestätigen muß bevor der Kopiervorgang ausgeführt wird, oder auch abgebrochen werden kann.
'Datum einfügen bei Doppelklick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("T4:AB250")) Is Nothing Or _
Target.Count > 1 Then Exit Sub
Cancel = True
Select Case Target.Row
Case 4 To 250
Target = Date
End Select
'Projekte in Mappen übergeben und dann löschen
If Intersect(Target, Range("AB4:AB250")) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True
With Sheets("Einkauf")
z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Target.Offset(, -27).Resize(, 37).Copy .Rows(z)
'nach Übergabe Zeile löschen in Projektübersicht
Target.EntireRow.Delete Shift:=xlUp
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: MsgBox
20.12.2019 08:10:12
volti
Hallo Stefan,
setze folgenden Code als erstes in Deine Sub.
If MsgBox("Soll wirklich kopiert werden?", vbYesNo Or vbQuestion, "Kopieren") = vbNo Then Exit Sub

viele Grüße
Karl-Heinz
Anzeige
AW: MsgBox
20.12.2019 08:18:03
Nepumuk
Hallo Stefan,
teste mal:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim lngRow As Long
    
    'Datum einfügen bei Doppelklick
    
    If Not Intersect(Target, Range("T4:AB250")) Is Nothing Then
        
        Cancel = True
        Target = Date
        
    End If
    
    'Projekte in Mappen übergeben und dann löschen
    
    If Not Intersect(Target, Range("AB4:AB250")) Is Nothing Then
        
        Cancel = True
        
        If MsgBox("Wollen sie wirklich kopieren?", vbQuestion Or vbOKCancel, "Abfrage") = vbOK Then
            
            With Worksheets("Einkauf")
                
                lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                Target.Offset(, -27).Resize(, 37).Copy .Rows(lngRow)
                'nach Übergabe Zeile löschen in Projektübersicht
                Target.EntireRow.Delete
                
            End With
        End If
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: MsgBox
20.12.2019 10:57:20
Stefan
Vielen Dank, so klappt es hervorragend!!!!
Gruß Stefan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige