XL 2010 vba pour masquer des colonnes lors d'un export

[Linda42]

Bonjour,

J'ai mis en place un tableau de bord avec une possibilité d'effectuer un export d'une partie seulement des données de ce fichier (bouton de contrôle associé à une macro, qui me permet d'exporter avec certaines spécificités - voir code ci-dessous)
Ce tableau est un planning mensuel qui commence automatiquement un lundi avec des formules qui dépendentde deux cellules : en C2 la date de début du mois et en c3 la date de fin de mois (j'ai donc parfois des colonnes qui ne font pas parti du mois entre les deux dates, et ceux en début de tableau, derniers jour de M-1, et en fin de tableau, premier jours M+1)

Lors de cet export, j'aimerais pouvoir masquer voir supprimer (je sais pas encore) toutes les colonnes dont la date n'est pas compris entre les dates que nous avons en c1 et c2. Exemple, si cela correspond au mois de janvier 2020, je voudrais masquer /supprimer les colonnes dont la date (info en ligne 7) est différente de janvier 2020, ceci, vous l'aurez compris pour avoir uniquement le planning du 1er au 31 janvier 2020, et pas du lundi 30 décembre 2019 au dimanche 9 février 2020.

Ci dessous la macro existante et dans laquelle je souhaiterais rajouter cette possibilité de masquer les colonnes :

Option Explicit
Sub Export_Récap_Tableau_bord_()
Dim wshSrc As Worksheet, wshDst As Worksheet
Dim rngSrc As Range
Dim nomDst As Variant
Dim chemin As String

  Set wshSrc = Worksheets(ActiveSheet.Name)
  Set rngSrc = wshSrc.Range("A1:Bd51")
  ' Création Export
  Set wshDst = Application.Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  With wshDst
    rngSrc.Copy .Range("A1")                    ' cellule de destination à adapter
    .Cells.FormatConditions.Delete 'supprime les MFC copiées
    Dim c As Range
    For Each c In rngSrc
        .Range(c.Address).Interior.Color = c.DisplayFormat.Interior.Color 'copie la couleur affichée
        .Range(c.Address).Interior.Pattern = c.DisplayFormat.Interior.Pattern 'copie le motif affiché
    Next
    
    .Range("A1").Resize(rngSrc.Rows.Count, rngSrc.Columns.Count).Value = rngSrc.Value
    .Columns.AutoFit
   Columns("A:A").ColumnWidth = 3.67
    Range("B4:I97").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Rows("5:5").Select
    Selection.Delete Shift:=xlUp
    Range("B4:C6").Select
    Columns("B:B").ColumnWidth = 30.89
    Columns("B:B").ColumnWidth = 32.44

    ActiveWindow.DisplayGridlines = False
    
    Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("V:V").Select
    Selection.EntireColumn.Hidden = True
    Columns("AD:AD").Select
    Selection.EntireColumn.Hidden = True
    Columns("AL:AL").Select
    Selection.EntireColumn.Hidden = True
    Columns("AT:AT").Select
    Selection.EntireColumn.Hidden = True
    Columns("BB:BB").Select
    Selection.EntireColumn.Hidden = True
    Range("G7").Select
    ActiveWindow.FreezePanes = True

    
    ActiveSheet.DrawingObjects.Delete
    Application.PrintCommunication = False
    With .PageSetup
      .PaperSize = xlPaperA4: .Orientation = xlLandscape
      .RightFooter = "&P/&N"
      .CenterHorizontally = True: .Zoom = False
      .FitToPagesWide = 1: .FitToPagesTall = 1
      
          With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
      
    End With
    Application.PrintCommunication = True
    .PrintPreview
  End With
  ' Sauvegarde Export
  chemin = ThisWorkbook.Path & "\..\Tableau de bord\TDB - Mensuel\"
  nomDst = "Tableau de bord - Mois " & wshSrc.Range("D2")
  On Error Resume Next
  wshDst.Parent.SaveAs chemin & nomDst
  If Err > 0 Then
    If Dir(chemin, vbDirectory) = "" Then chemin = ThisWorkbook.Path & "\..\"
    nomDst = Application.GetSaveAsFilename(FileFilter:="Excel (*.xlsx),*.xlsx", InitialFileName:=chemin & nomDst)
    If nomDst <> False Then wshDst.Parent.SaveAs nomDst
  End If
  If wshDst.Parent.Saved Then wshDst.Parent.Close
  On Error GoTo 0

End Sub

Ci-joint le dernier export effectué. Je ne peux pas joindre le fichier source car composée de plusieurs feuille et confidentiel.

Espérant que ces éléments vous permettront de m'aider.

Merci pour votre aide

 

[Staple1600]

Bonjour le fil, Linda42

Linda42
Ma façon de faire pour masquer les colonnes

Sub MasquerDémasquer()
Dim dDeb%, dFin%, pA As Range, pB As Range
dDeb = Application.Match([C2], Rows(6), 0) - 1
dFin = Application.Match([C3], Rows(6), 0) + 1
Set pA = Range(Cells(1, "G"), Cells(1, dDeb))
Set pB = Range(Cells(1, 53), Cells(1, dFin))
pA.EntireColumn.Hidden = Not pA.EntireColumn.Hidden = True
pB.EntireColumn.Hidden = Not pB.EntireColumn.Hidden = True
End Sub

Et une suggestion en passant pour alléger un peu ton code
Plus loin dans ton code, tu masques d'autres colonnes (avec des Select)
Tu peux réduire le tout sur une ligne
Range("N:N,V:V,AD:AD,AL:AL,AT:AT,BB:BB").EntireColumn.Hidden = True