Hyperlinks anpassen

[Icepic]

Hallo Ulrich,

ich habe mir doch die Zeit genommen und eine abgespeckte Version erzeugt.

Diese kann dir eventuell die Problematik näher erläutern.

Gruß Michael

[losgehts]

Hallo,

das von dir beschriebene Verhalten war wirklich außerhalb meiner Vorstellungskraft und für mich nicht reproduzierbar ohne deinen Code. Dank deiner Datei konnte ich nun das Verhalten nachvollziehen: es liegt daran, dass du einen Hyperlink bearbeitest, der vorher mit VBA kopiert wurde. Bei meinen ersten Tests mit deiner Datei werden immer die Hyperlinks(..).SubAddress vom Original und von allen von diesem kopierten Hyperlinks geändert.
Bspl: Es gibt Hyperlinks in C11, D11 und E11
wird ein neuer durch kopieren mit VBA von C11 in F11 angelegt und verändert, verändert sich C11 und F11
wird nun ein weiterer durch kopieren mit VBA von C11 nach G11 angelegt und verändert, verändern sich C11, F11 und G11
D11 und E11 bleiben original.

Wenn man zwichendurch die Datei speichert geht diese Abhängigkeit wohl (meinen wenigen Tests nach) verloren.


====================

Damit das hier nicht philosophisch wird, habe ich nicht weiter versucht, das zu ergründen, sondern schlage vor, den Hyperlink einfach neu anzulegen (zu überschreiben). Damit umgehe ich die Problematik mit der Abhängigkeit und komme zu einer Lösung, die bei mir auch in deiner Beispieldatei funktioniert.

Ich habe versucht so wenig wie möglich in deinen Code einzugreifen und ihn angepasst (ich würde manches ein wenig anders machen, doch das tut hier ja nichts zur Sache):

Code:

Sub probierMalSo()
    Dim iMax As Integer
    'Maximalwert aus Zeile 11 übernehmen
    iMax = WorksheetFunction.Max(Range("C11:N11"))
    'Anlegen neues Tabellenblatt
    Sheets("Firma 1").Copy After:=Sheets(Sheets.Count)
    'Rename neues Tabellenblatt
    Sheets(Sheets.Count).Name = "Firma " & iMax + 1
    'Zurueck nach Blatt Uebersicht
    Sheets("Tabelle1").Activate
    'Begin: letze linke Spalte um eine Spalte nach rechts versetzt kopieren
    With Range("C11").Offset(0, iMax)
        'Spalte C kopieren
        Range("C11:C25").Copy .Cells(1)
        iMax = iMax + 1
        'Firmennummer eintragen
        .Value = iMax
        'Hyperlink überschreiben
        .Hyperlinks.Add .Offset(0, 0), "", _
                        "'Firma " & CStr(iMax) & "'!A1", _
                        "", CStr(iMax)
        With Application.Intersect(Range("D11:D25").EntireRow, .EntireColumn)
            'Firmennummern in Formeln ändern
            .Replace What:="Firma 1", Replacement:="Firma " & iMax, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        End With
    End With
End Sub

Das Verhalten deiner Testdatei hat mich auch immens überrascht und ich kann es mir noch nicht erklären. Auch ich finde das nicht "logisch". Da muss ich mal drüber nachdenken und/oder andere Fragen - aber jetzt fehlt mir dazu die Zeit.

Kommst du damit zu einem zufriedenstellenden Ergebnis?
Grüße, Ulrich

PS: für die Zukunft:

Auch wenn ich nicht Alles, was du mir empfohlen hast, kommentiert habe, so habe ich es doch ausprobiert,
konnte aber das gewollte Ergebnis nicht erreichen. Dies sollte keine Missachtung deiner Vorschläge sein.

Ich nehme dir das auch überhaupt nicht krumm. Das Problem ist halt: wenn du mir nicht schreibst, dass du meinen Vorschlag getestet hast und er nicht funktioniert, dann weiß ich das nicht. Dann gehe ich weiterhin davon aus, dass mein Vorschlag funktioniert (sonst hätte ich es dir ja nicht geraten).
Wenn du dann nach weiteren Ideen fragst, wird das einfach nichts, weil ich ja glaube, dass mein Vorschlag funktioniert.

[Icepic]

Hallo Ulrich,

vielen Dank für deine Geduld und dein Engagement; das war die Lösung!

Viele Grüße aus Hamburg

Michael