Sub kopirujListy()
Dim jmSeznam As String
Dim jmVzor As String
jmSeznam = "SeznamListů"
jmVzor = "ListKeKopírování"
Dim jmenaListu As Range
Dim list As Worksheet
Dim bunka As Range
Application.ScreenUpdating = False
Sheets(jmSeznam).Activate
Set jmenaListu = Range("A2").CurrentRegion
For Each bunka In jmenaListu
On Error Resume Next
Set list = Worksheets(bunka.Value)
If Err.Number = 0 Then
Sheets(jmVzor).Copy after:=Sheets(bunka.Value)
ActiveSheet.Name = bunka.Value & "_check"
End If
Next bunka
Application.ScreenUpdating = True
End Subcitovat