Masquer colonne selon le nom de la feuille

Le 29/09/2020 à 15:54

Bonjour.

J'ai des formes dans une feuille auxquels j'ai associé des macro.

Une de ces macro fait une copie de la feuille XLSX en la renommant.

Je voudrais que seulement un range de colonne soit copié.

'**************************************
'Procédure pour copier feuille
'***************************************

'Worksheets("remplir").Copy After:=Worksheets("remplir")
'Dim nom_feuille As Variant

'nom_feuille = InputBox("Inscire le nom de la feuille qui sera copier")

'ActiveSheet.Name = nom_feuille
'Worksheets("remplir").Activate

*******************************

Je me demande aussi si VBA permet de savoir si un nom de feuille existe déjà. Le but serait

de renommer les feuilles nom(1), nom (2) automatiquement

Le 29/09/2020 à 17:49

Bonjour,

Pour copier une seule colonne après l'ajout d'une nouvelle feuille :

'METHODE 1 : AVEC BOITE DE DIALOGUE

Sub ajoutfeuille()

Worksheets.Add After:=Worksheets("remplir")

With ActiveSheet
    Worksheets("remplir").range("A:A").copy destination:=.cells(1,1)
    nom_feuille = InputBox("Inscrire le nom de la feuille qui sera copier")
    if not nom_feuille = "" then .Name = nom_feuille
end with

'Worksheets("remplir").Activate

end sub

'METHODE 2 : AUTOMATIQUEMENT

'FONCTION POUR TESTER L'EXISTENCE DE LA FEUILLE (D'APRÈS SON NOM)

Function WsExists(NomFeuille as string) as boolean

Dim ws as worksheet

for each ws in worksheets
    if ws.name = NomFeuille then
        WsExists = True
        exit function
    end if
next ws

end function

Sub ajoutfeuille()

Dim nom_souhaite$, nom_feuille$

nom_souhaite = "blabla" '<<<<<< remplacer
nom_feuille = nom_souhaite '1er test avec nom souhaité

while WsExists(nom_feuille) 'tant que la feuille nommée nom_feuille existe, on exécute ce qui suit :
    i = i + 1 'incrémentation
    nom_feuille = nom_souhaite & i 'nom_feuille = nom_souhaite & indice incrémenté pour nouveau test
wend

Worksheets.Add After:=Worksheets("remplir")

With ActiveSheet
    Worksheets("remplir").range("A:A").copy destination:=.cells(1,1)
    .name = nom_feuille
end with

'Worksheets("remplir").Activate

end sub

Cdlt,

Le 29/09/2020 à 20:36

Bonjour.

J'ai copier le code. Il fonctionne si je le fait rouler seul.

Merci beaucoup.

J'ai à l'intégrer dans une macro beaucoup plus longue.

Il me marque un message d'erreur de end_sub.

Je suis novice en VB.

Sub Copie()

'********************************
'message pour mise en route de routine de copie
'*************************************************

If MsgBox("Cette fonction va effectuer 3 tâches:" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "1- Copier les données dans la feuille gw_level" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "2-Faire une copie de la feuille remplir-Vous devrez la renommer" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "3-Effacer le formulaire" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Voulez-vous continuer?", vbExclamation + vbYesNo) = vbYes Then

'**************************************
'procédure pour changer les x en -
'*****************************************

Range("c11:h57").Replace what:="x", replacement:="-" 'remplacement du x en -

'************************
'macro pour copier cellule de Remplir vers GW_level
'**************************

Worksheets("gw_level").Activate

Cells(Rows.Count, 1).End(xlUp)(2).Select

ActiveCell.Value = Worksheets("remplir").Range("c9").Value 'A:nom de piezometre
ActiveCell.Offset(0, 1).Activate 'déplacement d'une colonne

...........

ActiveCell.Value = Worksheets("remplir").Range("G4").Value 'AT:Charge de projet

End If
_______________________________________________________________________fin de ma macro + insertion du code

'METHODE 2: AUTOMATIQUEMENT

'FONCTION POUR TESTER L'EXISTENCE DE LA FEUILLE (D'APRÈS SON NOM)

Function WsExists(NomFeuille As String) As Boolean

Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name = NomFeuille Then
WsExists = True
Exit Function
End If
Next ws

End Function

Dim nom_souhaite$, nom_feuille$

nom_souhaite = Range("C6").Value 'Valeur me ma cellule pour le nom de la feuille
nom_feuille = nom_souhaite '1er test avec nom souhaité

While WsExists(nom_feuille) 'tant que la feuille nommée nom_feuille existe, on exécute ce qui suit :
i = i + 1 'incrémentation
nom_feuille = nom_souhaite & i 'nom_feuille = nom_souhaite & indice incrémenté pour nouveau test
Wend

Worksheets.Add After:=Worksheets("remplir")

With ActiveSheet
Worksheets("remplir").Range("A1:h51").Copy Destination:=.Cells(1, 1)
.Name = nom_feuille
End With

'Worksheets("remplir").Activate

Worksheets("remplir").Activate

'*************************************
'Procédure pour vider le formulaire
'***********************************
Worksheets("remplir").Range("c9:h15").ClearContents 'Procédure pour effacer l'ensemble des données
Worksheets("remplir").Range("c17:h17").ClearContents 'Procédure pour effacer l'ensemble des données
Worksheets("remplir").Range("c19:h51").ClearContents 'Procédure pour effacer l'ensemble des données

MsgBox "Le contenu du formulaire a été éffacé"
End If

End Sub

Merci beaucoup.
Le 29/09/2020 à 22:00

En fait, la fonction est à mettre à part (elle est appelée à un moment par la procédure). Les fonctions sont comme des procédures sauf qu'elles renvoient une valeur (ici vrai ou faux en l'occurrence).

Voici ton code que j'ai par cette occasion retouché un peu :

Sub Copie()

dim fgw as worksheet, fremplir as worksheet, fnvl as worksheet
dim sautligne$, nom_souhaite$, nom_feuille$

'*************************************************
'1/message confirmation exécution copie
'*************************************************

sautligne = Chr(13) & Chr(10) & Chr(13) & Chr(10)

If not MsgBox("Cette fonction va effectuer 3 tâches:" & SAUT & _
"1- Copier les données dans la feuille gw_level" & SAUT & _
"2-Faire une copie de la feuille remplir-Vous devrez la renommer" & SAUT & _
"3-Effacer le formulaire" & SAUT & _
"Voulez-vous continuer?", vbExclamation + vbYesNo) = vbYes Then Exit Sub

Range("c11:h57").Replace what:="x", replacement:="-" 'remplacement du x en -
Set fgw = Worksheets("gw_level")
Set fremplir = Worksheets("remplir")

'************************
'2/macro pour copier cellule de Remplir vers GW_level
'**************************
With fgw 'SUR FEUILLE GW
    with .Cells(Rows.Count, 1).End(xlUp)(2) 'avec 1ere cellule non vide ? si tableau nommé, améliorer code
        .Value = fremplir.Range("c9").Value 'A:nom de piezometre 'valeur = C9 de remplir
        .Offset(0, 1).Value = fremplir.Range("G4").Value 'AT:Charge de projet 'valeur de cellule de droite = G4 de remplir
    end with
end with

'3/CREATION AUTOMATIQUE NOUVELLE FEUILLE, COPIE PLAGE ET REINITIALISATION REMPLIR
'*****************************************
With fremplir 'SUR REMPLIR
    nom_souhaite = .Range("C6").Value 'nom souhaité = C6 de remplir
    nom_feuille = nom_souhaite '1er test avec nom souhaité
    'boucle pour tester si existence du nom et le cas échéant adapter en incrémentant
    While WsExists(nom_feuille) 'tant que la feuille nommée nom_feuille existe, on exécute ce qui suit :
        i = i + 1 'incrémentation
        nom_feuille = nom_souhaite & i 'nom_feuille = nom_souhaite & indice incrémenté pour nouveau test
    Wend
    Set fnvl = Sheets.Add(After:=fremplir).name = nom_feuille 'ajout nouvelle feuille après remplir nommée nom_feuille
    .Range("A1:h51").Copy Destination:=fnvl.Cells(1, 1) 'copie A1:H51 de remplir vers nouvelle feuille
    .Range("c9:h15").ClearContents 'suppression contenus de remplir
    .Range("c17:h17").ClearContents 'idem
    .Range("c19:h51").ClearContents 'idem
end with

MsgBox "Le contenu du formulaire a été éffacé"

End Sub

'FONCTION POUR TESTER L'EXISTENCE DE LA FEUILLE (D'APRÈS SON NOM)

Function WsExists(NomFeuille As String) As Boolean

Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name = NomFeuille Then
WsExists = True
Exit Function
End If
Next ws

End Function

Cdlt,

Rechercher des sujets similaires à "masquer colonne nom feuille"