Formule VBA qui masque des cellules lors de la copie du workbook

Bonjour,

Je vous remercie d'avance pour le temps accordé.

Je m'explique j'ai une formule VBA que j'ai voulu modifier pour l'exécution rapide de fichier à partir d'une feuille base de donnée

La macro exécute parfaitement sont travail seulement après copie du fichier type les colones D et F sont masqué déformant donc mon fichier

J'ai trouver d'ou venez l'erreur en cherchent en pas à pas mais je n'ai pas su la résoudre

        Sheets("Type").Select
        az = ActiveSheet.Index
        'AC -> ID de la feuille type
        ActiveSheet.Copy ActiveWorkbook.Sheets(az)
        ActiveSheet.Name = aa

Si vous pouviez me trouver une solution

MERCI

P.S. : j'avais un fichier test a transmettre mais celui ci est trop volumineux

Bonjour,

Sauf erreur, si les colonnes sont masquées sur la feuille d'origine, elles le seront également sur la nouvelle. Donc, n'auriez-vous pas une partie du code qui masquerait ces colonnes justement ?

Voici un essai mais, si vous pouviez poster l'intégralité du code utile, ça pourrait être plus simple parce là on ne comprend pas très bien ce qui se passe.

        Sheets("Type").Copy after:=Sheets("Type")
        with ActiveSheet
            .Name = aa
            .columns("4:6").hidden = false
        end with

Cdlt,

Bonjour,

Merci de s'intéresser à mon sujet

Que ce soit le fichier type ou la feuille d'origine je n'ai pas vue a ma connaissance de partie du code masquant les colonnes et en dehors de la macro aucune ligne ou colonnes n'es masqué de l'ensemble des feuilles

Ici le code de la feuille d'origine

'Modifier une cellule
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim Buffer As String

    Dim r As Range

        ' teste si la cellule juste au dessus est remplie
    If Range("M20").Offset(-1) <> "" Then
        ' ajoute une ligne - la ligne s'insère au dessus
        Application.EnableEvents = False ' pour ne pas se mordre la queue
        Range("M20").EntireRow.Insert xlShiftDown
        Application.EnableEvents = True

        End If

    For Each r In Target
        'Si cellule à laisser
        If r.Column = DstDesCol Then

            Buffer = r.Value

            'Si valeur nulle
            If Buffer = "" Then
                r.Offset(0, DstUnitOffset).ClearContents

            'Si numérique (pas encore modifié)
            ElseIf IsNumeric(Buffer) Then
                i = FindRow(Buffer)

                'Affecter une valeur si on a trouvé
                If i > 0 Then
                    'Aller chercher dans la bibliothèque
                    With Sheets(BiblioSheet)
                        r.Value = .Cells(i, SrcDesCol).Value
                        r.Offset(0, DstUnitOffset).Value = .Cells(i, SrcUnitCol).Value
                    End With
                End If
            End If
        End If
    Next r
End Sub

'Trouver la ligne voulue
Private Function FindRow(ByVal vData As Integer) As Integer
    Dim i As Integer
    Dim Buffer As String

    i = 1
    Do
        i = i + 1
        Buffer = Sheets(BiblioSheet).Cells(i, IDCol).Value
    Loop While (Buffer <> "") And (Val(Buffer) <> vData)

    If Buffer <> "" Then FindRow = i

End Function

Et enfin le code de la macro (module)

Sub Macro1()
'

    Range("C20:C200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Type").Visible = True
    feuille1 = ActiveSheet.Name
    PZ11 = "C20"
    Range(PZ11).Select
    aa = Range(PZ11).Value
    Do
        fName = Application.GetSaveAsFilename
    Loop Until fName <> False
    'ActiveWorkbook.SaveAs Filename:=fName, FileFormat:= _
    'xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False

    Do While Not IsEmpty(aa)
        'Ici, la feuille 1 est active
        aa = ActiveCell.Value                   'Numéro
        If IsEmpty(aa) Then
            Exit Do
        End If
        Cells.EntireRow.Hidden = False
        ActiveCell.Offset(0, 2).Activate            'Désignation
        ab = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Utilisation
        ac = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Provenance
        ad = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Projet
        ae = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Emetteur
        af = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Phase
        ag = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Type Doc
        ah = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Zone
        ai = ActiveCell.Value
        ActiveCell.Offset(0, 2).Activate            'Indice
        aj = ActiveCell.Value
        ActiveCell.Offset(-7, -16).Activate         'Date
        ak = ActiveCell.Value
        ActiveCell.Offset(7, -2).Activate           'Numéro

        'Ici, c'est la feuille type qui est active
        Sheets("Type").Select
        az = ActiveSheet.Index
        'AC -> ID de la feuille type
        ActiveSheet.Copy ActiveWorkbook.Sheets(az)
        ActiveSheet.Name = aa
        ActiveSheet.Unprotect
        Range("F31").Value = aa
        Range("A27").Value = ab
        Range("A31").Value = ae
        Range("B31").Value = af
        Range("C31").Value = ag
        Range("D31").Value = ah
        Range("E31").Value = ai
        Range("G31").Value = aj
        Range("D14").Value = ak
        Range("G19").Value = ak

        Range("G41").Value = aa
        Range("G42").Value = aa
        Range("B47").Value = ab
        Range("B50").Value = ac
        Range("B53").Value = ad
        Range("A44").Value = ae
        Range("B44").Value = af
        Range("C44").Value = ag
        Range("D44").Value = ah
        Range("E44").Value = ai
        Range("G44").Value = aj

        'Activation feuille 1
        Sheets(feuille1).Select
        ActiveCell.Offset(1, 0).Activate
        Cells.EntireRow.Hidden = False
    Loop
    Sheets("Type").Visible = False
End Sub

En ce qui concerne le look de mon fichier d'origine et de mon fichier type les voici

Fichier source :

Fichier type :