IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Copier coller feuille dans 2nd fichier


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Homme Profil pro
    Ingénieur sécurité
    Inscrit en
    Août 2011
    Messages
    94
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Corrèze (Limousin)

    Informations professionnelles :
    Activité : Ingénieur sécurité
    Secteur : Industrie

    Informations forums :
    Inscription : Août 2011
    Messages : 94
    Par défaut Copier coller feuille dans 2nd fichier
    Bonjour le forum,

    Dans la macro ci-dessous l'utilisateur peut copier une feuille d'un fichier vers un autre fichier en ayant la possibilité de renommer l'onglet de la feuille copiée dans le fichier archive. Voir ci dessous


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
          ' Macro utilisée pour enregistrer l'analyse de risque dans le fichier HISTO.xls
    Sub EnrHisto()
    nom_du_fichier_initial = ActiveWorkbook.Name
    'Supprime les caractères .XLS
    nom_du_fichier = Left(nom_du_fichier_initial, _
                                Len(nom_du_fichier_initial) - 4)
    nom_du_fichier = UCase(nom_du_fichier)
     
    '----------------
    If Right(nom_du_fichier, 5) = "HISTO" Then
        nom_du_fichier = Left(nom_du_fichier, _
                                Len(nom_du_fichier) - 6)
        nom_du_fichier = nom_du_fichier + ".xls"
        position_onglet = 2
        ' Supprime les boutons
     
    Else
        nom_du_fichier = nom_du_fichier + " HISTO.xls"
        position_onglet = 1
     
    End If
    nom_fiche_active = ActiveSheet.Name
     
    If nom_fiche_active <> "Fiche prépa" Then
        Msg = "VOUS N'ETES PAS SUR VOTRE ANALYSE DE RISQUE!!"
        Title = "Attention ERREUR!!!!!"   ' Définit les titres.
        ' Affiche le message.
        Réponse = MsgBox(Msg, Style, Title)
    Else
        Réponse = 7
    End If
     
    On Error GoTo Affichage_message_erreur
     
    Select Case Réponse
    Case 7
        Sheets(nom_fiche_active).Copy Before:=Workbooks( _
            nom_du_fichier).Sheets(position_onglet)
     
    Case 6
        nombre_de_feuille = Sheets.Count
        If nombre_de_feuille > 1 Then
            Sheets(nom_fiche_active).Move Before:=Workbooks( _
                nom_du_fichier).Sheets(position_onglet)
        Else
            Msg = "Il n'est pas possible de déplacer une feuille seule" & Chr(13) & _
                    "Pour la transférer, choisissez : COPIER"
            Style = vbOK + vbExclamation  ' Définit les boutons.
            Title = "Erreur mineure"   ' Définit les titres.
            ' Affiche le message.
            Réponse = MsgBox(Msg, Style, Title)
        End If
    Case Else
        Windows(nom_du_fichier_initial).Activate
        On Error GoTo 0
        Exit Sub
    End Select
     
    On Error GoTo 0
     
    If nom_fiche_active = "Fiche prépa" Then
        'Affiche message : nom de la feuille
        Msg = "Vous enregistrez votre analyse de risque dans le fichier HISTO. Veuillez lui donner un nom!!!"
        Title = "Copie de l'analyse de risque dans un autre fichier"   ' Définit les titres.
        Réponse = InputBox(Msg, Title)
        If Réponse = "" Then
            Windows(nom_du_fichier_initial).Activate
            Exit Sub
        End If
        Sheets(position_onglet).Name = Réponse
    End If
     
    Windows(nom_du_fichier_initial).Activate
    Exit Sub
     
    Affichage_message_erreur:
        Msg = "Le fichier de copie n'a pas été trouvé."
        Style = vbOKOnly + vbExclamation  ' Définit les boutons.
        Title = "Erreur pénalisante"   ' Définit les titres.
        ' Affiche le message.
        Réponse = MsgBox(Msg, Style, Title)
        Exit Sub
    Resume
     
    End Sub
    Tout cela fonctionne bien, mais je souhaiterais éviter que l'utilisateur ne puisse pas enregistrer deux feuilles différentes avec le même nom et qu'il ne puisse saisir un nom qu'avec 31 caractères maximum. Pour éviter le débogage dans les deux cas.

    Merci pour votre aide

    Cordialement

  2. #2
    Expert confirmé Avatar de jfontaine
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Juin 2006
    Messages
    4 756
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 51
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Contrôleur de Gestion

    Informations forums :
    Inscription : Juin 2006
    Messages : 4 756
    Par défaut
    Bonjour,

    Une solution, on boucle sur toute les feuilles du classeur pour vérifier si ce nom existe.
    Si pas existant on ajoute le nom en utilisant les 31 premiers caractères

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
     
    Dim sh as Worksheet    
    Réponse = InputBox(Msg, Title)
        If Réponse = "" Then
            Windows(nom_du_fichier_initial).Activate
            Exit Sub
        End If
        'Contrôle si nom existant
        For Each sh In ThisWorkbook.Worksheets
          If sh.Name = Left(Réponse , 31) Then
            MsgBox "Onglet existant"
            Exit Sub
          End If
        Next
        Sheets(position_onglet).Name = Left(Réponse , 31)
    NB : Eviter les noms de variables avec des accents

    Edit : Ajout du Exit sub comme justement suggéré par BBil

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] copier coller valeur dans une autre feuille avec itération de colonne
    Par profnans dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 24/02/2013, 19h21
  2. [XL-2007] Copier plusieurs feuilles de plusieurs fichier dans une seule feuille
    Par QcSylvanio dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 03/10/2012, 22h02
  3. [XL-2007] copier/coller 1plage dans plusieur feuilles
    Par revans dans le forum Macros et VBA Excel
    Réponses: 27
    Dernier message: 27/06/2012, 12h15
  4. copier coller couleur dans une autre feuille grâce a un bouton
    Par antoine2933 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 04/07/2011, 22h52
  5. Syntaxe Copier/coller vers un autre fichier dans VBA.
    Par Benjycool dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 12/01/2009, 10h49

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo