טופס -> העתק כשורה לטבלה עם היפר קישור

[kremer21]

טופס -> העתק כשורה לטבלה עם היפר קישור

בוקר טוב,
מערכת win 10 אופיס 365

עזרתכם חברים,לא מצאתי פונקציה היפר קישור או לינק.

לאחר הקלדה בטופס לחיצה על לחצן מאקרו להכנסת השורה לתוך טבלה הוספה בכל הקלדה.
השדה האחרון (10) מוקלד לשם באופן קבוע קישור לתיקייה או לאתר
Sheets("DB").Cells(DBC, 10).Value = Sheets("Training Form").Range("H17").Value

הנתונים מעותקים לטבלה אבל הקישור מעותק כערך ובטבלה אינו עובד

** - הרצוי - הקישור יעותק לטבלה כקישור ולא כערך value

Sub Addline()


Dim J As Integer
Dim L As Integer
Dim DBC As Long 'DBC = Data Base Counter for next available row
Dim CallerFile
Dim iReply As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False


If Sheets("Training Form").Range("H3,I3").Value = "" Then
MsgBox "all fields are mandatory"
Exit Sub
End If
If Sheets("Training Form").Range("H1").Value = "" Then
MsgBox "all fields are mandatory"
Exit Sub
End If
If Sheets("Training Form").Range("B15").Value = "" Then
MsgBox "all fields are mandatory"

Exit Sub
End If

DBC = 2
Do While Sheets("DB").Cells(DBC, 1).Value <> ""
DBC = DBC + 1
Loop

Sheets("DB").Cells(DBC, 1).Value = Sheets("Training Form").Range("H15").Value
Sheets("DB").Cells(DBC, 2).Value = Sheets("Training Form").Range("H1").Value
Sheets("DB").Cells(DBC, 3).Value = Sheets("Training Form").Range("H2").Value
Sheets("DB").Cells(DBC, 4).Value = Sheets("Training Form").Range("H3").Value
Sheets("DB").Cells(DBC, 5).Value = Sheets("Training Form").Range("H11").Value
Sheets("DB").Cells(DBC, 6).Value = Sheets("Training Form").Range("E11").Value
Sheets("DB").Cells(DBC, 7).Value = Sheets("Training Form").Range("B13").Value
Sheets("DB").Cells(DBC, 8).Value = Sheets("Training Form").Range("B15").Value
Sheets("DB").Cells(DBC, 9).Value = Sheets("Training Form").Range("B17").Value
Sheets("DB").Cells(DBC, 10).Value = Sheets("Training Form").Range("H17").Value





DBC = DBC + 1

ActiveWorkbook.save

End Sub