Erweiterung eines Makros um eine Messagebox
28.04.2017 10:59:47
Jenny
habe soweit unten stehendes, funktionierendes Makro.
Ich würd das Ganze alllerdings um eine Messagebox erweitern und bitte um eure Hilfe da ich sowas noch nie gemacht habe.
Es geht darum, dass wie ihr sicher seht 9 Adressen von Hyperlinks nach Tabelle2 kopiert werden.
Ich suche eine Möglichkeit, dass wenn weniger als 9 Adressen da sind (weniger als 9 in den Zellen in denen das Makro sucht, nicht in der gesamten Spalte) dass ich dann ne Meldung bekomme und entscheiden kann ob trotzdem kopieren oder abbrechen.
Ist das machbar?
Danke für eure Hilfe
Jenny
PS: Da ich heut Geburtstag hab und mitten in den Vorbereitungen stecke, eilt es nicht ganz so.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngZeile As Long
Dim lngZiel As Long
Dim shaShape As Shape
If Target.Cells(1).Address(False, False) = "A1" Then
With Worksheets("Tabelle2")
If .Range("A1") = "" Then
lngZiel = 1
Else
lngZiel = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp). _
_
Row, .Rows.Count) + 1
End If
For lngZeile = 8 To 104 Step 12
If Cells(lngZeile, 1).Hyperlinks.Count > 0 Then
.Cells(lngZiel, 1) = Cells(lngZeile, 1).Hyperlinks(1).Address
lngZiel = lngZiel + 1
End If
Next lngZeile
End With
Application.EnableEvents = False
ActiveSheet.Cells.Clear
Application.EnableEvents = True
For Each shaShape In ActiveSheet.Shapes
shaShape.Delete
Next shaShape
End If
End Sub