Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Makro kopiert Hyperlink nicht mit
#1
Hallo liebe clever-excel-Community,

ich bin absolut am Verzweifeln Huh  - folgende Problemstellung:

Meine Excel Mappe besteht aus zwei Blättern ,,Liste" und ,,Erledigt".
Auf der ,,Liste" befinden sich in jeder Zeile Aufgaben, welche abgearbeitet werden sollen.
Sobald ich in der B-Spalte ein ,,ja" eintippe und Enter drücke, wird die entsprechende Zeile auf das ,,Erledigt"-Blatt verschoben.

Hierfür habe ich den untenstehende Code, welcher auch fehlerfrei funktioniert. Blush

Der Knackpunkt: Es sind in der ,,Liste" auch Hyperlinks vorhanden, welche beim Verschieben verloren gehen.
D.h., dass in der ,,Erledigt" Liste nur noch der Zeileninhalt steht. Der Hyperlink ist verschwunden.

Ich bin mir sicher, dass es nur einer kleinen Änderung im Code bedarf.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngErste As Long
    If Target.Column = 2 Then
        If Target.Count = 1 Then
            If UCase(Target) = "JA" Then
                With Worksheets("Erledigt")
                    lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
                        .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                    Rows(Target.Row).Copy
                    .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
                    Rows(Target.Row).Delete shift:=xlUp
                End With
            End If
        End If
    End If
End Sub

Ich möchte mich im Vorfeld schon einmal für die Hilfe bedanken!

Übrigens: Ich hatte schon viel recherchiert und ähnliche Threads gefunden, jedoch weicht mein Code massiv von den dort Angegebenen ab. Dadurch helfen mir diese leider nichts...


Schöne Grüße
Unwissender
Antwortento top
#2
Hallo,

da mit

Code:
.Cells(lngErste, 1).PasteSpecial Paste:=xlValues

eingefügt wird, ist das Ergebnis logisch (ungeprüft)

Mit einer Schleife über alle Hyperlinks des ersten Blatt, sollten diese aber auch kopiert werden können.

mfg
Antwortento top
#3
Hallo,

vielen Dank für die Antwort!

Wäre es für dich ein großer Umstand den Code kurz zu überarbeiten?
Ich weiß leider überhaupt nicht, wie ich das angehen soll.

Danke und schöne Grüße
Unwissender
Antwortento top
#4
Hallo,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngErste As Long
If Target.Column = 2 Then
If Target.Count = 1 Then
If UCase(Target) = "JA" Then
With Worksheets("Erledigt")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Target.EntireRow.Cut .Cells(lngErste, 1)
End With
End If
End If
End If
End Sub
Gruß Uwe
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • Unwissender
Antwortento top
#5
Hallo Uwe,

vielen vielen Dank!

Funktioniert einwandfrei 18


Schöne Grüße
Unwissender
Antwortento top
#6
Entschuldigt, aber eine kurze Frage noch:
 
Aktuell wird die Ganze Zeile aus der ,,Liste" ausgeschnitten und in ,,Erledigt" eingefügt - soweit so gut.
Jedoch verbleibt dann in der ,,Liste" eine weiße leere Zeile.
 
Es wäre natürlich schön, wenn diese weiße/leere verbleibende Zeile nach dem verschieben auch verschwindet.
In anderen Worten: Der Rest soll nach oben aufrücken und die Lücke schließen.
 
Das wäre doch sicherlich mit ,,Target.EntireRow.Delete" oder so ähnlich lösbar.
Wo müsste ich so einen Befehl im Code einfügen?
 
Hier noch einmal der aktuelle Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngErste As Long
    If Target.Column = 2 Then
        If Target.Count = 1 Then
            If UCase(Target) = "JA" Then
                With Worksheets("Erledigt")
                    lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
                        .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
                    Target.EntireRow.Cut .Cells(lngErste, 1)
                End With
            End If
        End If
    End If
End Sub
 
 
 Danke und schöne Grüße
Unwissender
Antwortento top
#7
Hallo,

ja stimmt, Du wolltest die Zeile ja ganz löschen. Du hattest den Befehl auch schon drin gehabt.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngErste As Long
If Target.Column = 2 Then
If Target.Count = 1 Then
If UCase(Target) = "JA" Then
With Worksheets("Erledigt")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Target.EntireRow.Copy .Cells(lngErste, 1)
Target.EntireRow.Delete
End With
End If
End If
End If
End Sub
Gruß Uwe
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • Unwissender
Antwortento top
#8
Vielen Dank Uwe, hat funktioniert!Smile
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste