Prílohu XLSM môžete pridať iba zabalenú do ZIP. Tu máte návrh riešenia, bez kontroly či obsahuje list nejaké dáta, či existuje list a pod.:
Sub Copy2Sheet()
Dim LastRow As Long, List As String
With Sheets("TABKOL")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
List = .Range("AB2").Value
Sheets(List).Range("A1:Y" & LastRow).Value = .Range("B1:Z" & LastRow).Value
Application.Goto Sheets(List).Range("A1")
End With
End Sub
A nebude stačiť použiť písmo WingDings na Label ?
Mne to fachá. Tak veľa zdaru.
Ten 1 pomocný stĺp bych tam nechal pre PF
=XOR(D3<>D2;U2)
EDIT: Sorry marjankaj, nevšimol som si. Keď som reloadoval, tak to tu nebolo.
Chýbajú tam apostrofy
CESTA = "'[" & ThisWorkbook.Name & "]" & "List1'!D5"
ale hlavne to postráda zmysel, načítať hodnotu otvoreného súboru cez EVALUATE. Veď poznáte meno zošitu aj listu aj adresu bunky, tak si dajte
Workbooks("TEST5.xlsm").Worksheets("List1").Range("D5").Value
a
ThisWorkbook.Worksheets("List1").Range("D5").Value
OT: @ marjankaj :
Ale prd, len som lenivý, nechce sa mi, som taký nejaký poklesnutý a demotivovaný z tej celej situácie okolo covitu ... nikoho neumravňujem 
Dajte nejakú prílohu, nech si to nemusíme vytvárať zase sami. Aspoň pár kategórií a dát. Dáta nemusia byť tie Vaše, kľudne vymyslené, ale rovnakého formátu, typu a rozmiestnenia.
Návod ako to sprevádzkovať.
marjankaj má pravdu, v týchto 2 prípadoch tam treba ešte pridať kontrolu na samotný deň. V druhom prípade sa naopak vypúšťa kontrola času.
Nie som teraz pri PC, ale myslím, že bude stačiť tie dve časové podmienky obaliť do NOT().
Pr.
Pomocné stĺpce asi ani nepotrebujete.
Súbor otvárať nemusíte. Môžete použiť buď metódu ExecuteExcel4Macro, alebo vzorec do nepoužívanej bunky.
Sub Porovnaj()
Dim Hodnota
With ThisWorkbook.ActiveSheet
With .Range("H4")
.Formula = "='" & ThisWorkbook.Path & "\[TEST2.xlsm]List1'!$D$5"
Hodnota = .Value
.ClearContents
End With
If Hodnota = .Range("D5").Value Then
MsgBox "Bunky se rovnají"
Else
MsgBox "Bunky se NErovnají", vbCritical
End If
End With
End Sub
Sub Porovnaj2()
Dim Hodnota
With ThisWorkbook
Hodnota = Application.ExecuteExcel4Macro("'" & .Path & "\[TEST2.xlsm]List1'!R5C4")
If Hodnota = .ActiveSheet.Range("D5").Value Then
MsgBox "Bunky se rovnají"
Else
MsgBox "Bunky se NErovnají", vbCritical
End If
End With
End Sub
Na pár buniek ExecuteExcel4Macro rýchlostne v pohode. Na tisíce použite z týchto dvoch metód radšej tie vzorce.
Public Sub PridajHyperlink()
'Pridať referenciu na Microsoft Word 16.0 Object Library
Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next
Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
With objSel
If Len(.Text) > 1 Then .Hyperlinks.Add .Range, .Text
End With
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objDoc = Nothing
Set objInsp = Nothing
End Sub
Pridať Modul, pridať referenciu, kód do modulu. Pridať na karte Vložiť novú skupinu, pridať do nej makro. Vo VBA editore Uložiť.
V Centre zabezpečenia v nastaveniach treba povoliť všetky makrá.
Tak?
Oblíbený formulář Faktura byl vylepšen a rozšířen.

Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.