Sub Skryt_radky() Dim rng As Range Set rng = GetOblast1 If rng Is Nothing Then MsgBox "Žádné viditelné řádky označené pomocí 1.", vbExclamation Else rng.EntireRow.Hidden = True End If End Sub Sub Zobrazit_radky() Range("E4:E51").EntireRow.Hidden = False End Sub Function GetOblast1() As Range Dim h(), i As Long With Range("E3:E51") h = .Value For i = 1 To UBound(h, 1) If h(i, 1) = 1 Then If Not .Cells(i).EntireRow.Hidden Then If GetOblast1 Is Nothing Then Set GetOblast1 = .Cells(i).Resize(, 4) Else Set GetOblast1 = Union(.Cells(i).Resize(, 4), GetOblast1) End If End If Next i End With End Function Sub OdeslatMailem() Dim OlApp As Object, wdRange As Object, rng As Range Set rng = GetOblast1 If rng Is Nothing Then MsgBox "Žádné viditelné řádky k odeslání označené pomocí 1.", vbExclamation: Exit Sub Else Set rng = Union(Range("F2:I3"), rng.Offset(0, 1)) End If On Error Resume Next Set OlApp = GetObject(, "Outlook.Application") On Error GoTo 0 If OlApp Is Nothing Then Set OlApp = CreateObject("Outlook.Application") With OlApp.CreateItem(0) .Recipients.Add "odeslat@sem.cz" .Subject = "Zasílám " & Format(Date, "dd.mm.yyyy") & " tyto hodnoty" With .GetInspector.WordEditor .Content = "Dobrý den, zde máte tabulku: " & vbCrLf & vbCrLf With .Range .Collapse Direction:=wdCollapseEnd rng.Copy .Paste End With Application.CutCopyMode = False End With '.Send .Display End With Set OlApp = Nothing: Set wdRange = Nothing End Sub