Copie feuil

[loisphil]

Bonjour forum,

Dans un USF j'ai le code suivant pour copier un feuil "Masque" et renommer l'onglet en fonction du nom de cellule "C5" vers un classeur avec ouverture/écriture/sauvegarde/fermeture je voudrais intégrer un code pour vérifier si cette feuil existe si c'est le cas (Msgbox info) et la renommer le cas échéant dans mon USF et re valider
J’ai essayé d'intégrer différents code sans résultats.

merci pour votre aide
phil

Private Sub Valider_Click()

Dim wkB As Workbook
Dim ctl As Object

If MSL.Value = True Then

    On Error Resume Next
    
	[COLOR="Green"]'Ouvrir le classeur MSL.xls[/COLOR]
    Set wkB = Workbooks.Open(ThisWorkbook.Path & "\MSL.xls")
    If err > 0 Then
        MsgBox "Une erreur c'est produite lors de l'ouverture du classeur MSL", n, "Copier la feuille vers MSL.xls"
        Exit Sub
    End If
    [COLOR="Green"]'Copier la feuille dans classeur MSL.xls[/COLOR]
    ThisWorkbook.Sheets("Masque").Copy After:=wkB.Sheets(Sheets.Count)  
    
	[COLOR="green"]'Changer le nom de la feuille créée[/COLOR]
    ActiveSheet.Name = ThisWorkbook.Sheets("Masque").Range("C5")
 
        [COLOR="green"]'Détruire les éventuels objets shapes  de la feuille[/COLOR]
    For Each ctl In ActiveSheet.Shapes
        ctl.Delete
    Next
 
    wkB.Save 'Sauvegarde
    wkB.Close 'Fermeture
Else
...........

 

[JNP]

Re : Copie feuil

Bonjour Loisphil 🙂,
Ce petit bout de code ferait-il ton bonheur ?

Dim Feuille As Worksheet, NouveauNom As String
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name = ThisWorkbook.Sheets("Masque").Range("C5") Then
    NouveauNom = InputBox("Veuillez donner un nouveau nom pour l'onglet", "Onglet existant")
    NouveauNom = Replace(NouveauNom, "\", "_")
    '...
Else
    NouveauNom = ThisWorkbook.Sheets("Masque").Range("C5")
End If
Next
ActiveSheet.Name = NouveauNom

les ... sont à remplacer par la même ligne qu'au dessus avec les caractères spéciaux non tolérés par les onglets.
Bon courage 😎

 

[loisphil]

Re : Copie feuil

bsr JNP,forum

merci d'avoir repondu
mais malheureusement non !
je n'utilise pas inputbox mais une tbx dans un USF
et les caracateres speciaux ne sont pas utilsés seulement des numero taper dans la tbx apres le meme nom j'ai essayer de bidouiller ton code mais sans succés !!

 

[JNP]

Re : Copie feuil

Re 🙂,
Je ne suis pas tout... Que ce soit une InputBox ou un TextBox dans un USF, la boucle sur les feuilles ne peut que marcher... Tu ne prends pas le nom de ton fichier dans une TextBox vu que ta ligne de code le prends dans la cellule C5... Et une TextBox acceptera n'importe quel caractère si tu n'as pas du code derrière pour l'empêcher 😕...
Ne peux-tu mettre un bout de fichier, que l'on comprenne mieux ?
Bonne soirée 😎

 

[SubEndSub]

Re : Copie feuil

Bonjour chez vous


J'utilise pour supprimer des formes automatiques le code suivant

ActiveSheet.Shapes.SelectAll
Selection.Delete

 

[SubEndSub]

Re : Copie feuil

Rebonsoir chez vous


Pour tester si la feuille Masque existe

Sub macro()
Dim wkB As Workbook
Set wkB = Workbooks.Open(ThisWorkbook.Path & "\MSL.xls")
If Not WorksheetExists("Masque") Then
ThisWorkbook.Sheets("Masque").Copy After:=wkB.Sheets(Sheets.Count)
'Changer le nom de la feuille créée
With ActiveSheet
    .Name = ThisWorkbook.Sheets("Masque").Range("C5")
    .Shapes.SelectAll
    Selection.Delete 'Détruire les éventuels objets shapes de la feuille
End With
End If
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function

 

[loisphil]

Re : Copie feuil

Bsr JPN , SubEndSub , Forum

JPN , SubEndSub pour transmettre le fichier il faut que je passe par Cijoint.fr alors voila l'adresse


Cijoint.fr - Service gratuit de dépôt de fichiers

j'ai appliqué le code uniquement sur le classeur PREFA.xls

ne soyez pas trop dur !! je suis loin d'être un expert

merci a vous, forum..


voici un code qui fonctionne.....
mais le souci c'est au niveau de l'incrementation dans la feuil "RepPrefa" du classeur DEBUT.xls ca me met le meme N° que la feuil originale et l'incrementation repart avec un mauvais N°

Dim wkB As Workbook
Dim ctl As Object
Dim Li As Byte
Dim Feuille As Worksheet, NouveauNom As String

If PREFA.Value = True Then

    On Error Resume Next
    [COLOR="Green"]'Ouvrir le classeur PREFA.xls[/COLOR]
    Set wkB = Workbooks.Open(ThisWorkbook.Path & "\PREFA.xls")
    If err > 0 Then
        MsgBox "Une erreur c'est produite lors de l'ouverture du classeur MSL", vbExclamation, "Copier la feuille vers classeur PREFA.xls"
        Exit Sub
    End If
   [COLOR="Green"] ' fallait mettre wkB pour le chemin[/COLOR]
    [COLOR="Blue"]For Each Feuille In wkB.Worksheets[/COLOR]
        If Feuille.Name = TextBox3.Value Then
        MsgBox "ce dossier existe deja ! renommer"
       
        wkB.Save 'Sauvegarde
        wkB.Close 'Fermeture
    
    Exit Sub
      End If
        Next
    
   [COLOR="Green"] 'Copier la feuille dans classeur PREFA.xls[/COLOR]
    ThisWorkbook.Sheets("Masque").Copy After:=wkB.Sheets(Sheets.Count)
    'Changer le nom de la feuille créée
    ActiveSheet.Name = NouveauNom
        
   [COLOR="Green"] 'Détruire les éventuels objets shapes  de la feuille[/COLOR]
    For Each ctl In ActiveSheet.Shapes
        ctl.Delete
    Next
 
    wkB.Save 'Sauvegarde
    wkB.Close 'Fermeture
end if