26 Aufrufe
Gefragt in Tabellenkalkulation von

Hallo

Die Frage steht ja schon in der Überschrift

Den Zellinhalt von Spalte D in ein anderes Blatt kopieren, aber nur wenn ein @ Zeichen darin vorkommt.
Und es ist nicht vorhersehbar in welcher Zeile dieses @-Zeichen kommt. Daher muss die ganze Spalte überwacht werden.
Ziel soll dann das 2. Blatt in der Exceldatei sein, beginnend mit Einfügen in Spalte A, Zeile 1

Wenn also in D3 ein @-Zeichen erscheint, danns soll das im Blatt 2 in A1 eingetragen werden.
Kommt das nächste @ erst in D5, dann soll in Blatt 2 in A2 eingetragen werden use.

Hat einer eine Idee?

Danke und Gruß

3 Antworten

0 Punkte
Beantwortet von beverly_ Mitglied (797 Punkte)

Hi,

versuche es mal so:

Sub Kopieren()
    Dim hyZelle As Hyperlink
    Dim lngZiel As Long
    lngZiel = 1
    For Each hyZelle In Worksheets("Tabelle1").Columns(4).Hyperlinks
        If InStr(hyZelle.Address, "@") > 0 Then
            hyZelle.Parent.Copy Worksheets("Tabelle2").Cells(lngZiel, 1)
            lngZiel = lngZiel + 1
        End If
    Next hyZelle
End Sub


Bis später, Karin

0 Punkte
Beantwortet von
Ohje, das sind ja Böhmische Dörfer für mich :-(

Trotzdem Danke Karin.
Ich werd mich wohl noch etwas einlesen müssen
0 Punkte
Beantwortet von beverly_ Mitglied (797 Punkte)

Hi,

es handelt sich doch um Mailadressen - oder? Diese werden von Excel als Hyperlink erkannt und damit als Spezialzellen. Deshalb kann man alle Spezialzellen in Spalte D durchlaufen (ohne dass Zellen ohne Hyperlink berücksichtigt werden) und dann die Linkadresse kopieren, wobei nach dem Kopieren die Zielzeile um 1 erhöht werden muss. Hier nochmal der Code mit ein paar Kommentaren damit du nachvollziehen kannst, was abläuft.

Sub Kopieren()
    Dim hyZelle As Hyperlink    ' Variable für Hyperlinkzellen
    Dim lngZiel As Long         ' Variable für Zielzeile
    ' Startzeile im Zieltabellenblatt ist 1
    lngZiel = 1
    ' laufe über alle Zellen mit Hyperlinks in Spalte D
    For Each hyZelle In Worksheets("Tabelle1").Columns(4).Hyperlinks
        ' Zieladresse des Hyperlinks enthält das Zeichen @
        If InStr(hyZelle.Address, "@") > 0 Then
            ' kopiere die Hyperlinkadresse nach Tabelle2 Spalte A in Zielzeile
            hyZelle.Parent.Copy Worksheets("Tabelle2").Cells(lngZiel, 1)
            ' Zielzeile um 1 erhöhen
            lngZiel = lngZiel + 1
        End If
    Next hyZelle
End Sub


Erstelle im VBA-Editor ein Standardmodul und kopiere den Code dort hinein. Anschließend kannst du im Register: Ansicht -> Befehlsgruppe: Makros -> Schalter: Makros das Makro "Kopieren" aufrufen und ausführen.

Bis später, Karin

...