Public Sub ExpPDF()
    Dim t As Workbook, lc As Long, i As Long, k As Long, nm as String
    'On Error Resume Next
    Set t = ThisWorkbook
    Application.ScreenUpdating = False
    With ActiveSheet
        lc = .Cells(2, .Columns.Count).End(xlToLeft).Column
        ReDim arr(1 To 1)

        For i = 1 To lc
            If .Cells(2, i) <> "" Then
                k = k + 1
                If k = 1 Then t.Sheets(CStr(.Cells(2, i))).Copy Else t.Sheets(CStr(.Cells(2, i))).Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
            End If
        Next i
        If k = 0 Then Exit Sub
    End With

    nm = ThisWorkbook.Path & "\" & Format(Now, "DDMMYY_hhnnss") & ".pdf"    ' имяфайла и путь целиком

    On Error Resume Next
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nm, Quality:=xlQualityStandard _
                    , IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False

    ActiveWorkbook.Close False

    With t.Sheets("Ш")
        i = 1
        Do While .Cells(2, i) <> ""
            If .Cells(2, i) = 0 Then .Columns(i).Hidden = True Else .Columns(i).Hidden = False
            i = i + 1
        Loop
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=nm & "_Ш", Quality:=xlQualityStandard _
                           , IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False

        .Columns.Hidden = False
    End With
    
    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub

    np = "C:\Users\...\Печать" & "\" & Format(Now, "DD.MM.YY")

    If Dir(np, vbDirectory) = "" Then MkDir np
    
    nm = "C:\Users\...\Печать" & "\" & Format(Now, "DD.MM.YY") & "\" & Format(Now, "DD.MM.YY")

    On Error Resume Next
    np = "C:\Users\...\Печать\" & Format(Now, "DD_MM_YY")
    MkDir np
    nm = np & "\" & Format(Now, "DD_MM_YY") & ".pdf"