Excel 2010 Makro läuft nicht unter Excel 365

[Pean]

Hallo zusammen,

Hatte unter Excel 2010 ein einfaches Makro, welches eine bestehende Tabelle am Ende um eine Zeile erweitert und einen Hyperlink in der ersten Zelle einfügt. Unter Excel 365 wird die Tabelle nicht mehr um eine Zeile erweitert und der Hyperlink wird unterhalb der Tabelle eingefügt.
Jemand eine Idee, was ich anpassen muss im Makro?

With ThisWorkbook.Worksheets("Projects").ListObjects("Projects")
            .Parent.Hyperlinks.Add _
              Anchor:=.Range(1, 1).Offset(.ListRows.Count + 1, 0), Address:="", _
              SubAddress:="'" & ID & "'!A1", _
              TextToDisplay:=ID
              End With


Besten Dank
Grüsse Pean

[Pean]

Zum besseren Verständnis, hier ganze Makro, welches unter Excel 2010 prima funktionierte, unter Excel 365 aber nicht mehr richtig.
Das Makro erstellt ein Tabellenblatt und fügt in einer Tabelle einen Hyperlink dazu ein. Rot markiert, der Teil, welcher nicht mehr korrekt funktioniert unter Excel 365.
Anstatt die Tabelle um eine Zeile zu erweitern, wird der Eintrag nur unter der Tabell eingefügt.

Sub new_Project()

    Dim sheet As Worksheet
    Dim ID As String
    Static lngCalc As Long
   
    With Application
            lngCalc = .Calculation
            .ScreenUpdating = False
            .EnableEvents = False
            .DisplayAlerts = False
            .Calculation = -4135
            .Cursor = xlWait
 
    End With

      ID = ThisWorkbook.Sheets("Projects").Cells(5, 2).Value
      ThisWorkbook.Sheets("template").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
  ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = ID
          With ThisWorkbook.Worksheets("Projects").ListObjects("Projects")
            .Parent.Hyperlinks.Add _
              Anchor:=.Range(1, 1).Offset(.ListRows.Count + 1, 0), Address:="", _
              SubAddress:="'" & ID & "'!A1", _
              TextToDisplay:=ID
          End With
 Exit Sub

[RPP63]

Moin!
So ganz ohne Datei ist das Problem schwierig nachzuvollziehen.
Aber warum erweiterst Du das ListObject nicht "vorschriftsmäßig" und verlässt Dich statt dessen auf die automatische Erweiterung?

Natürlich ungetestet:

PHP-Code:

With ThisWorkbook.Worksheets("Projects").ListObjects("Projects").ListRows.Add
            .Parent.Parent.Hyperlinks.Add _
              Anchor:=.Cells(1), Address:="", _
              SubAddress:="'" & ID & "'!A1", _
              TextToDisplay:=ID
          End With 


Gruß Ralf

[snb]

Verwende nur:

Code:

Sub new_Project()
  With ThisWorkbook
    .Sheets("template").Copy , .Sheets(.Sheets.Count)
    .Sheets(.Sheets.Count).Name = .Sheets("Projects").Cells(5, 2).Value
    With .Sheets("Projects")
      .Hyperlinks.Add .Cells(Rows.Count, 1).End(xlUp).Offset(1), , .Sheets(.Sheets.Count).Cells(1).Address(, , , True), .Cells(5, 2).Value
      .ListObjects(1).Resize .Cells(1).CurrentRegion
    End With
  End With
End Sub

[Pean]

Hallo RPP63,

Danke für deinen Input. Die Erweiterung der Tabelle würde so funktionieren, jedoch wird danach kein Hyperlink in der letzten Zelle eingetragen.

Grüsse Pean

---

Hallo SNB,

Danke auch dir für den Input.
Bekomme bei der Ausführung von 

.Hyperlinks.Add .Cells(Rows.Count, 1).End(xlUp).Offset(1), , .Sheets(.Sheets.Count).Cells(1).Address(, , , True), .Cells(5, 2).Value

folgende Fehlermeldung

"Objekt unterstützt diese Eigenschaft oder Methode nicht"

Grüsse
Pean

[Case]

Hallo,  

bei mir funktioniert in Excel 365...

  ListObject_Zeile_hinzufuegen_Hyperlink_setzen_CEF.xlsb (Größe: 16,83 KB / Downloads: 2)

[Kuwer]

Hallo Pean,

Code:

With ThisWorkbook.Worksheets("Kundenliste").ListObjects("Tabelle2")
    .Resize Range(.Range.Address).Resize(.Range.Rows.Count + 1)
    .Parent.Hyperlinks.Add _
    Anchor:=.Range(1, 1).Offset(.ListRows.Count, 0), Address:="", _
    SubAddress:="'" & Kundennummer & "'!A1", _
    TextToDisplay:=Kundennummer

---

'  VBA, XML, HTML => Forum-HTML, © 2018 by KHV (VBA) und Haklesoft (VB)

Gruß Uwe
 

[Pean]

Vielen Dank Kuwert für deine schnelle Reaktion....funktioniert wieder perfekt.

---

Danke Case für dein Feedback....konnte die Lösung von Kuwert verwenden.


Grüsse
Pean