|
Kann mir jemand beim Hyperlink weiterhelfen?
Was ist hier falsch?
'Link in die Zelle
sFormel = "=HYPERLINK(""#" & sNameNeu & """; """ & sNameNeu & """)"""
wksEin.Cells(Anzahl, 3).FormulaR1C1 = sFormel
Sub Einzelprotokoll_erstellen()
'
' neu Makro
'
Dim Anzahl As Long, lngLRow As Long 'Anzahl als Zählerindex, lngLRow als letzte beschriebene Zeile
Dim wksEin As Worksheet, wksPlan As Worksheet, wksNeu As Worksheet 'Variablen für die Worksheets
Dim sNameNeu As String
Dim sFormel As String
'On Error GoTo Fehler
'Worksheets den Variablen zuteilen
Set wksEin = ThisWorkbook.Worksheets("Prüfprotokoll")
Set wksPlan = ThisWorkbook.Worksheets("Vorlage")
'letzte beschriebene Zeile in Tabellenblatt("Prüfprotokoll")
lngLRow = wksEin.Cells(wksEin.Rows.Count, 2).End(xlUp).Row
For Anzahl = 8 To lngLRow
'neues Tabellenblatt erstellen und umbennen
wksPlan.Copy After:=Worksheets(Worksheets.Count) 'kopieren ans Ende der Mappe
Set wksNeu = Worksheets(Worksheets.Count) 'setzen der neuen Tabelle
sNameNeu = wksEin.Range("C" & Anzahl).Text
wksNeu.Name = sNameNeu 'neue Tabelle benennen
'Link in die Zelle
sFormel = "=HYPERLINK(""#" & sNameNeu & """; """ & sNameNeu & """)"""
wksEin.Cells(Anzahl, 3).FormulaR1C1 = sFormel
'Set wksNeu = Sheets.Add(After:=Sheets(Sheets.Count))
'wksNeu.Name = wksEin.Range("C" & Anzahl).Text
'übernehmen der Vorlage
'wksPlan.Rows("1:39").Copy 'Kopieren
'wksNeu.Paste Destination:=wksNeu.Range("A1") 'Einfügen
'Application.CutCopyMode = False 'Selection-Rahmen entfernen
'füllen der Zellen im neuen Tabellenblatt
wksNeu.Cells(5, 3) = wksEin.Cells(Anzahl, 2)
wksNeu.Cells(6, 3) = wksEin.Cells(Anzahl, 3)
wksNeu.Cells(8, 3) = wksEin.Cells(Anzahl, 4)
wksNeu.Cells(8, 4) = wksEin.Cells(Anzahl, 5)
wksNeu.Cells(8, 5) = wksEin.Cells(Anzahl, 6)
wksNeu.Cells(5, 8) = wksEin.Cells(Anzahl, 7)
wksNeu.Cells(23, 13) = wksEin.Cells(Anzahl, 8)
wksNeu.Cells(24, 13) = wksEin.Cells(Anzahl, 9)
wksNeu.Cells(25, 13) = wksEin.Cells(Anzahl, 10)
wksNeu.Cells(26, 13) = wksEin.Cells(Anzahl, 11)
wksNeu.Cells(29, 13) = wksEin.Cells(Anzahl, 12)
wksNeu.Cells(30, 13) = wksEin.Cells(Anzahl, 13)
Next Anzahl
Exit Sub
Fehler:
MsgBox "Da war ein Fehler"
End Sub
|