Macro : copie de feuille

  • Initiateur de la discussion Initiateur de la discussion Moulinois
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Moulinois

XLDnaute Occasionnel
[Problème Résolu]

Bonjour !

J'ai un classeur A, un classeur S0B et un classeur Z dans un même dossier.

J'ouvre A et Z et je lance depuis A la macro de Z. Comment faire pour que cette macro, en lisant "B" dans une case (B3) de A copie la feuille unique de S0B dans A et la renome ?

La première feuille de A (la feuille historique 😉) devra se voir ensuite créer des formules par la macro, formules qui feront référence au second onglet (renommé par la macro sus-citée).

Merci !


(Il vous faut un exemple ou ça vous paraît à peu près clair ?)
 
Dernière édition:
Re : Macro : copie de feuille

bonjour Moulinois,

voici une macro qui peut te servir de modèle éventuel.

Code:
Sub MacroDeZ()
    Dim i As Integer
    Dim wkb_A As Workbook, wkb_SOB As Workbook
    Dim NouveauNom As String
    
    For i = 1 To Workbooks.Count
        If Workbooks(i).Name = "ClasseurA.xls" Then
            Set wkb_A = Workbooks(i)
        ElseIf Workbooks(i).Name = "ClasseurSOB.xls" Then
            Set wkb_SOB = Workbooks(i)
        End If
    Next

    If wkb_A Is Nothing Then
        Set wkb_A = Workbooks.Open(ThisWorkbook.Path & "\ClasseurA.xls")
    End If
    
    If wkb_SOB Is Nothing Then
        Set wkb_SOB = Workbooks.Open(ThisWorkbook.Path & "\ClasseurSOB.xls")
    End If
    
    If wkb_SOB Is Nothing Or wkb_A Is Nothing Then
        MsgBox "Impossible d'identifer un des classeurs nécessaires à la macro!" & vbCrLf & _
                "Vérifiez leur existence et recommencez.", vbExclamation, "MacroDeZ"
        Exit Sub
    End If
        
    If wkb_A.Sheets(1).Range("B3") = "B" Then
        NouveauNom = InputBox("entrez un nom pour la nouvelle feuille")
    End If
    
    wkb_SOB.Sheets(1).Copy After:=wkb_A.Sheets(wkb_A.Sheets.Count)
    If NouveauNom <> "" Then ActiveSheet.Name = NouveauNom
    
    
End Sub

Bien sûr les noms de feuille et ou classeur sont à redéfinir.

A bientôt
 
Re : Macro : copie de feuille

Re,

Ca marchera pas 😀

S0B ne s'appelle S0B que parce qu'il y a "B" En B3 du classeur A (qui change de nom également d'un dossier à l'autre d'ailleurs).

Donc dans mon cas, il faudrait que la macro lise 46189 (46190 une autre fois, 72535 une autre etc) en B3 et définisse le S046189.xls du dossier (/!\ il n'est pas ouvert quand je lance la macro) comme wkb_S0B.



Pour essayer d'être clair : Depuis A, je lance une macro contenue dans Z. Cette macro lit dans la cellule B3 de A : "#####". Elle s'en sert alors pour copier la feuille unique de S0#####.xls (qui n'est pas ouvert) comme seconde feuille de A et la renommer en "Non gérés" (nom fixe cette fois 🙂)
 
Re : Macro : copie de feuille

bonjour Moulinois,

As-tu passé un bon Week-End?

Je suis en train de travailler sur ton problème, un petit Détail pour voir si je comprends Bien.

tu voudrais que l'unique feuille des classeurs "SOXXXX.xls" soit copiée dans une unique feuille "Non gérés" du classeur A, l'une à la suite des autres? C'est ça?

A bientôt
 
Re : Macro : copie de feuille

Re, Moulinois,

Voici une solution, suivant ce que j'ai compris de ta demande.

Code:
Private Function Get_WKB(NomClasseur As String) As Workbook
    Dim wkb_Temp As Workbook
    'Vérifié si le classeur est déjà ouvert
    On Error Resume Next
    Set wkb_Temp = Workbooks("NomClasseur")
    If wkb_Temp Is Nothing Then
        ' il n'est pas ouvert, on l'ouvre à partir du répertoire du classeur actuel
        ' 'Répertoire de Z
        Set wkb_Temp = Workbooks.Open(ThisWorkbook.Path & "\" & NomClasseur)
    End If
    Set Get_WKB = wkb_Temp
    On Error GoTo 0
End Function

Sub MacroDeZ()

    Dim i As Integer
    Dim wkb_A As Workbook, wkb_B As Workbook
    Dim sh As Worksheet
    
    Dim NomClasseur As String
    Dim Derligne As Long, nbLignes As Long
    
    Set wkb_A = Get_WKB("ClasseurA.xls")
    If Not wkb_A Is Nothing Then
        If ThisWorkbook.Sheets(1).Range("B3").Text <> "" Then
            NomClasseur = "SO" & ThisWorkbook.Sheets(1).Range("B3") & ".xls"
            Set wkb_B = Get_WKB(NomClasseur)
            If wkb_B Is Nothing Then
                MsgBox "le classeur: " & NomClasseur & " est introuvable!", vbExclamation, "MacroDeZ"
                Exit Sub
            End If
        Else
            MsgBox "Veuillez entre un nom valide dans " & wkb_A.Name & " " & wkb_A.Sheets(1).Name & " en cellule B3", _
                    vbExclamation, "MacroDeZ"
            Exit Sub
        End If
    Else
      MsgBox "ClasseurA.xls introuvalbe!", vbExclamation, "MacroDeZ"
      Exit Sub
    End If
        
    On Error Resume Next
    Set sh = wkb_A.Sheets("Non gérés")
    On Error GoTo 0
    
    If sh Is Nothing Then
        Set sh = wkb_A.Sheets.Add
        sh.Name = "Non gérés"
    End If
        
    'Toutes les conditions sont remplies
    With sh
        'Dernière ligne de la feuille 'Non Gérés'
        Derligne = .Range("A" & .Rows.Count).End(xlUp)
        
        'Nombre de lignes à copiées de la feuille de wkb_B dans 'Non gérés'
        nbLignes = wkb_B.Sheets(1).UsedRange.Rows.Count
        
        'Vérifie si 'Non gérés' n'est pas pleine
        If Derligne + nbLignes + 1 < .Rows.Count Then
          ' Elle n'est pas pleine, on copies les ligne
           wkb_B.Sheets(1).UsedRange.Copy Destination:=.Range("A" & Derligne + 1)
        Else
           MsgBox "La feuille 'Non gérés' du classeur " & wkb_A.Name & " est pleine!", _
                vbExclamation, "MacroDeZ"
        End If
    End With
    
End Sub

Bonne semaine
 
Re : Macro : copie de feuille

bonjour Moulinois,
Bonjour !
As-tu passé un bon Week-End?
Excellent, et toi ?

tu voudrais que l'unique feuille des classeurs "SOXXXX.xls" soit copiée dans une unique feuille "Non gérés" du classeur A, l'une à la suite des autres? C'est ça?
Pas O mais 0 😉
Oui, je voudrais que cette feuille soit copiée dans une seule feuille, à la suite de celle qui est déjà dans le classeur A.




Pour ta macro.............ça ne marche pas 🙁
Je me rends compte que je n'ai pas été clair.
ClasseurA ne s'appelle pas comme ça. C'est le classeur courant à partir duquel je lance la macro (contenue, elle, dans un autre classeur), son nom est différent à chaque fois.


A+
 
Re : Macro : copie de feuille

Re,
je te laisse modifier.😉
Justement, je peux pas mettre un nom fixe puisqu'il change tout le temps. Je dois faire référence au classeur depuis lequel la macro a été lancée (...et je sais pas faire 🙁)

Question: pourquoi ne pas tous piloter à partir du classeur qui contient la macro? Ou mettre cette macro dans 'Le classeur des macros personnelles'?
Ben c'est ce que je fais.
J'ai un fichier qui contient la macro (qui gonfle au fur et à mesure que le temps passe ; la tienne sera le dernier morceau de cette "grosse" macro) et deux fichiers A & B (QUI NE S'APPELLENT PAS COMME CA EN REALITE puisque leur nom change car j'utilise la macro sur des fichiers différents à chaque fois) et celui de la macro (qui est dans un autre dossier [dans le sous-répertoire du dessus], d'ailleurs).

J'ouvre le classeur Z (qui contient la macro) et le classeur A (qui CHANGE DE NOM à chaque fois que je fais la manipulation).
Je lance la macro z de Z DEPUIS A et elle doit :
- le mettre en forme (Le classeur A qui change de nom)
- rajouter des formules
- copier la feuille de S0##### dans le classeur A et la renommer car des cellules de la première feuille s'y réfèreront.

Veux-tu un *.zip ?

A+
 
Re : Macro : copie de feuille

RE,
bonjour voici où nous en sommes.

1 - Ouvrir le classeur qui contient la macro (ici ClasseurZ)
2 - Ouvrir un classeur X d'où on lancera la macro de CLasseurZ
'MACRO
1 -Dans le classeur Actif (ici classeur X) En Feuil1.range("B3") on a pour valeur:XXX.
2 - Transformer cette valeur en "S0XXX.xls".
3 - Ouvrir "S0XXX.xls", Copier les données de son unique feuille
4 - Coller dans la feuille 'Non gérés' du classeur X à la suite des autres données.
5 - Revenir sur Classeur X
'Fin MACRO

Code:
Private Function Get_WKB(NomClasseur As String) As Workbook
    Dim wkb_Temp As Workbook
    'Vérifié si le classeur est déjà ouvert
    On Error Resume Next
    Set wkb_Temp = Workbooks("NomClasseur")
    On Error GoTo 0
    If wkb_Temp Is Nothing Then
        ' il n'est pas ouvert, on l'ouvre à partir du répertoire du classeur actuel
        ' 'Répertoire de Z
        If Dir(ThisWorkbook.Path & "\" & NomClasseur) <> "" Then
            Set wkb_Temp = Workbooks.Open(ThisWorkbook.Path & "\" & NomClasseur)
            Set Get_WKB = wkb_Temp
        Else
            MsgBox "Le classeur " & NomClasseur & " est introuvalbe!" & _
                    "dans : " & ThisWorkbook.Path, vbExclamation, "Get_WKB"
        End If
    End If
End Function

Sub MacroDeZ()

    Dim i As Integer
    Dim wkb_A As Workbook, wkb_B As Workbook
    Dim sh As Worksheet
    
    Dim NomClasseur As String
    Dim Derligne As Long, nbLignes As Long
    
    Set wkb_A = ActiveWorkbook
    
        If wkb_A.Sheets(1).Range("B3").Text <> "" Then
            NomClasseur = "S0" & ThisWorkbook.Sheets(1).Range("B3") & ".xls"
            Set wkb_B = Get_WKB(NomClasseur)
            If wkb_B Is Nothing Then Exit Sub
        Else
            MsgBox "Veuillez entre un nom valide dans " & wkb_A.Name & " " & wkb_A.Sheets(1).Name & " en cellule B3", _
                    vbExclamation, "MacroDeZ"
            Exit Sub
        End If
        
    On Error Resume Next
    Set sh = wkb_A.Sheets("Non gérés")
    On Error GoTo 0
    
    ' Trouve ou rajoute la feuille 'Non gérés'
    If sh Is Nothing Then
        Set sh = wkb_A.Sheets.Add
        sh.Name = "Non gérés"
    End If
        
    'Toutes les conditions sont remplies
    With sh
        'Dernière ligne de la feuille 'Non Gérés'
        Derligne = .Range("A" & .Rows.Count).End(xlUp)
        
        'Nombre de lignes à copiées de la feuille de wkb_B dans 'Non gérés'
        nbLignes = wkb_B.Sheets(1).UsedRange.Rows.Count
        
        'Vérifie si 'Non gérés' n'est pas pleine
        If Derligne + nbLignes + 1 < .Rows.Count Then
          ' Elle n'est pas pleine, on copies les ligne
           wkb_B.Sheets(1).UsedRange.Copy Destination:=.Range("A" & Derligne + 1)
           
           ' Réactive le classeur A
           wkb_A.Activate
        Else
           MsgBox "La feuille 'Non gérés' du classeur " & wkb_A.Name & " est pleine!", _
                vbExclamation, "MacroDeZ"
        End If
    End With
    
End Sub


On va bien finir par y arriver!😉
 
Re : Macro : copie de feuille

Re,
RE,
bonjour voici où nous en sommes.

1 - Ouvrir le classeur qui contient la macro (ici ClasseurZ)
2 - Ouvrir un classeur X d'où on lancera la macro de CLasseurZ
'MACRO
1 -Dans le classeur Actif (ici classeur X) En Feuil1.range("B3") on a pour valeur:XXX.
2 - Transformer cette valeur en "S0XXX.xls".
3 - Ouvrir "S0XXX.xls", Copier les données de son unique feuille
4 - Coller dans la feuille 'Non gérés' du classeur X à la suite des autres données. Non non : Il faut copier son unique feuille (de S0XXX) dans une nouvelle feuille de X à intituler "Non gérés" (où il n'y aura que ça). Depuis la première feuille, je vais ensuite chercher des infos dans la feuille "Non gérés"
4 bis - Fermer S0XXX.xls
5 - Revenir sur Classeur X
'Fin MACRO
Là je crois que le processus est le bon
On va bien finir par y arriver!😉
Ouaip


A +
 
Dernière édition:
Re : Macro : copie de feuille

Hello
Alors remplacer MacroDeZ par celle-ci:

Code:
Sub MacroDeZ()

    Dim i As Integer
    Dim wkb_A As Workbook, wkb_B As Workbook
    
    Dim NomClasseur As String
    Dim Derligne As Long, nbLignes As Long
    
    Set wkb_A = ActiveWorkbook
    
    If wkb_A.Sheets(1).Range("B3").Text <> "" Then
        NomClasseur = "S0" & wkb_A.Sheets(1).Range("B3") & ".xls"
        Set wkb_B = Get_WKB(NomClasseur)
        If wkb_B Is Nothing Then Exit Sub
    Else
        MsgBox "Veuillez entre un nom valide dans " & wkb_A.Name & " " & wkb_A.Sheets(1).Name & " en cellule B3", _
                vbExclamation, "MacroDeZ"
        Exit Sub
    End If
        
    wkb_B.Sheets(1).Copy after:=wkb_A.Sheets(1)
    ActiveSheet.Name = "Non gérés"
    wkb_B.Saved = True
    wkb_B.Close
    
End Sub

A bientôt
 
Re : Macro : copie de feuille

Re,

C'est très bien. Il ne manque plus qu'une chose : Z n'est pas placé dans le même répertoire que X et S0XXX. Mais on a du bol parce que X et S0XXX sont dans le même dossier 😀
Du coup, il faudrait récupérer le chemin vers X (depuis lequel on lance la macro) pour savoir où est S0XXX............comment on fait ? 😀

Merci

A plus
 
Dernière édition:
Re : Macro : copie de feuille

Re,

Si, en lieu et place de NomClasseur = "S0" & wkb_A.Sheets(1).Range("B3") & ".xls", je mettais NomClasseur = wkb_A.Path & "S0" & wkb_A.Sheets(1).Range("B3") & ".xls", ça marcherait ?

(La formule qui l'utilise est Set wkb_B = Get_WKB(NomClasseur))



.............ou alors ça va mettre le bazar dans la fonction ? 😀
(-> Dans ce cas je créé NomClasseur2, composé du path de A et de NomClasseur ?)


A plus
 
Re : Macro : copie de feuille

re bonjour,

Oui cela marcherait à condition que tu n'oublies pas de rajouter l'anti-slash entres les deux:


wkb_A.Path & "\S0" & wkb_A.Sheets(1).Range("B3") & ".xls"

de plus la fonction serait:

Code:
Private Function Get_WKB(NomClasseur As String) As Workbook
    Dim wkb_Temp As Workbook
    'Vérifié si le classeur est déjà ouvert
    On Error Resume Next
    Set wkb_Temp = Workbooks("NomClasseur")
    On Error GoTo 0
    If wkb_Temp Is Nothing Then
        ' il n'est pas ouvert, on l'ouvre à partir du répertoire du classeur actuel
        ' 'Répertoire de Z
        If Dir( NomClasseur) <> "" Then
            Set wkb_Temp = Workbooks.Open(NomClasseur)
            Set Get_WKB = wkb_Temp
        Else
            MsgBox "Le classeur " & NomClasseur & " est introuvalbe!" , vbExclamation, "Get_WKB"
        End If
    End If
End Function

bonne programation
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
406
Réponses
20
Affichages
767
Réponses
7
Affichages
325
Retour