Microsoft 365 vider plage extensible

[jamespatagueul]

Bonsoir,

je cherche à vider des plages de cellules qui seront amener à s'agrandir (en colonnes, pas en lignes).
dans le fichier joint, il y a un début de structure, seul les cellules blanches sont à vider.

autre point, je souhaiterai également pouvoir copier-coller la dernière colonne à la suite de celle-ci (format, formule ... avec des cellules fusionnées).

et tout ça en vba.
niveau très moyen en vba
Merci de votre aide.

bonne soirée

 

[sylvanu]

Bonsoir,
Pas sur d'avoir tout compris, mais effacer toutes les cellules blanches peut être fait par :

Sub Efface()
    [4:43,49:88,94:133].ClearContents
End Sub

Quant à dupliquer la dernière colonne, comment sait on qu'on est sur la dernière colonne ?
Couleur, contenu ... ?

 

[jamespatagueul]

Bonjour sylvanu,
merci de votre réponse.

Pour le copier-coller, je cherche à ajouter une colonne après la dernière existante, sans déplacer celle existante, car je récupère les données de celle-ci. J'ai complété le fichier un peu plus.
et oui, couleur, formule, mise en forme ....
peu on faire ça avec un userform ? car je souhaiterai que le nouveau nom de la colonne se note dans le récap en dessous de la dernière ligne de l'établissement 1 ou 2 ou .... selon le choix fait, avec les formule adapter à pour cette nouvelle colonne.

Belle journée

 

[sylvanu]

Bonjour Christophe,
Un essai en PJ avec :

Public Nom$, L%
Sub InsererColonne()
    Dim DC%
    Nom = InputBox("Nom de la nouvelle colonne :")
    Application.ScreenUpdating = False
    With Sheets("donnée")
        .Select
        DC = .Cells(2, Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1, DC), .Cells(1, DC + 1)).EntireColumn.Copy
        .Range(.Cells(1, DC + 2), .Cells(1, DC + 3)).EntireColumn.Select
        ActiveSheet.Paste: Application.CutCopyMode = False
        .Cells(2, DC + 2) = Nom
        .[A1].Select
    End With
    L = 0
    For N = 1 To 3: InsererLigne: Next N
End Sub
Sub InsererLigne()
    With Sheets("recap")
        .Select: L = L + 2
        While .Cells(L, 1) <> ""
            L = L + 1
        Wend
        .Rows(L - 1 & ":" & L - 1).Copy
        .Rows(L & ":" & L).Insert Shift:=xlDown
        .Cells(L, 1) = Nom
    End With
End Sub

Bien conserver les deux variables en Public car elles sont utilisées dans les deux modules.
Regardez en page Recap j'ai fait quelques modifs pour simplifier les formules.

 

[jamespatagueul]

Bonjour Christophe,
Un essai en PJ avec :

Public Nom$, L%
Sub InsererColonne()
    Dim DC%
    Nom = InputBox("Nom de la nouvelle colonne :")
    Application.ScreenUpdating = False
    With Sheets("donnée")
        .Select
        DC = .Cells(2, Columns.Count).End(xlToLeft).Column
        .Range(.Cells(1, DC), .Cells(1, DC + 1)).EntireColumn.Copy
        .Range(.Cells(1, DC + 2), .Cells(1, DC + 3)).EntireColumn.Select
        ActiveSheet.Paste: Application.CutCopyMode = False
        .Cells(2, DC + 2) = Nom
        .[A1].Select
    End With
    L = 0
    For N = 1 To 3: InsererLigne: Next N
End Sub
Sub InsererLigne()
    With Sheets("recap")
        .Select: L = L + 2
        While .Cells(L, 1) <> ""
            L = L + 1
        Wend
        .Rows(L - 1 & ":" & L - 1).Copy
        .Rows(L & ":" & L).Insert Shift:=xlDown
        .Cells(L, 1) = Nom
    End With
End Sub

Bien conserver les deux variables en Public car elles sont utilisées dans les deux modules.
Regardez en page Recap j'ai fait quelques modifs pour simplifier les formules.

Bonjour sylvanu,
Je réalise plusieurs test et vois si cela va comme je le pense.
merci de votre réponse.