Copier/Coller des feuilles d'un classeur 2 vers classeur 1 avec VBA

Bonsoir,

Je galère à essayer de copier les feuilles du classeur 2 vers classeur 1.

J'ouvre le classeur 1, j'exécute la macro qui me permet de sélectionner mon classeur 2. Un USF s'ouvre et liste les feuilles présentes dans le Classeur 2.

Je sélectionne par exemple la Feuil3 et j'aimerais que cette feuille se colle dans le Classeur 1.

J'ai mis des commentaires dans le classeur 1 pour vous aider.

Merci aux gens qui pourront m'aider !

JB

Bonjour

Je modifierais vos codes comme ceci :

1. Dans le module 1, remplacez toutes les lignes par ceci

Option Explicit
Public wb As Workbook
Public wbkc As Workbook
Sub MaSub()
Dim myfile

myfile = Application.GetOpenFilename("Excel Files (*.xls*), *xls*", , "Sélectionnez un fichier")

If myfile = False Then
    MsgBox "Annulé", vbOKOnly + vbExclamation, "EXCEL"
    Exit Sub
End If

Set wb = Workbooks.Open(myfile)
Set wbkc = ThisWorkbook
UserForm1.Show
End Sub

2. Dans l'USF, remplacez la Private sub Initialize

Private Sub UserForm_Initialize()
'Déclare la variable objet Worksheet
Dim Ws As Worksheet

For Each Ws In wb.Worksheets
    ListBox1.AddItem Ws.Name
Next Ws
End Sub

3. Dans l'USF supprimez le code Private Sub UserForm_Deactivate()

4. Dans le module Importation _donnees, remplacez cette ligne dans le code Import

wb.Sheets(nom_ouvrage).Copy After:=wbkc.Sheets(wbkc.Sheets.Count)

Faites un test

Si ok n'oubliez pas ... -->

Cordialement

Bonjour,

Ok, merci beaucoup je vais essayer cela.

Par contre le classeur 2 contient des macros, et une fois que la feuille du classeur 2 est collée dans le classeur 1 si je veux exécuter les macros Excel ouvre le classeur 2. Comment faire pour rompre le lien avec le Classeur 2 ou dans le meilleur des cas, affecter les macros au classeur1.

PS: Les2 classeurs sont identiques.

Merci

JB

Par contre le classeur 2 contient des macros, et une fois que la feuille du classeur 2 est collée dans le classeur 1 si je veux exécuter les macros Excel ouvre le classeur 2. Comment faire pour rompre le lien avec le Classeur 2 ou dans le meilleur des cas, affecter les macros au classeur1.

Là je n'ai pas compris. Les macros sont où dans votre fichier classeur 2 ?
Dans la feuille ou dans un module ?

A nouveau,

Je vous ai transmis plus haut un fichier d'exemple, en réalité, mon classeur 2 contiendra des macros.

Les 2 classeurs sont identiques, les macros sont dans un module.

Pour résumer, je voudrais que lorsque je clique sur le bouton "jb" sur ma feuille, que ça soit la macro "TEST_JB" du classeur 1 qui soit exécutée au lieu de la macro "TEST_JB" du classeur 2.

je pensais écrire quelque chose comme cela à la suite du copier/coller mais cela ne fonctionne pas:

wbkc.Shape("jb").OnAction= wbkc.!Module1.TEST_JB"

Que faudrait-il utiliser ?

Merci

JB

Pour résumer, je voudrais que lorsque je clique sur le bouton "jb" sur ma feuille, que ça soit la macro "TEST_JB" du classeur 1 qui soit exécutée au lieu de la macro "TEST_JB" du classeur 2.

Votre bouton est sur le classeur 1 ou le 2 ?
Au vu du code j'ai compris que le bouton de commande se trouve sur le classeur 1 puisque vous ouvrez le classeur 2 avec le code du classeur 1

A moins que les feuilles que vous copiez ont un bouton sur la feuille et que vous voulez réattribuer au code du classeur 1 ?

A nouveau,

A moins que les feuilles que vous copiez ont un bouton sur la feuille et que vous voulez réattribuer au code du classeur 1 ? => C'est exactement ça.

Je poste l'exemple avec les classeurs 1 et 2.

On sélectionne le classeur 2 depuis le classeur 1, on choisit la Feuil3, (la macro va supprimer la feuille 3 dans le "classeur 1" pour la remplacer par la Feuil3 du "classeur 2"). Sauf que la Feuil3 du "classeur 2" contient un bouton avec macro. J'aimerais qu'une fois le copier/coller réalisé, le bouton sur la Feuil3 du "classeur 1" exécute la macro présente dans le" classeur 1" et non plus le "classeur 2".

Merci beaucoup en tout cas !

JB

Remplacez le code Sub Import_data par celui ci-dessous

Sub import_data()
Dim nom_ouvrage As String
Dim f As Worksheet

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

For i = UserForm1.ListBox1.ListCount - 1 To 0 Step -1
    If UserForm1.ListBox1.Selected(i) = True Then
        nom_ouvrage = UserForm1.ListBox1.List(i) 'nom de la feuille qui apparait dans le USF
        With wbkc
            .Sheets(nom_ouvrage).Delete  'on supprime du Classeur1 la feuille sélectionné dans le USF
            wb.Sheets(nom_ouvrage).Copy After:=.Sheets(wbkc.Sheets.Count)
            .ActiveSheet.Shapes("JB").OnAction = "Masub"
            .Sheets(1).Activate 'est-ce nécessaire cette ligne ?
        End With
    End If
Next i
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

A voir si c'est nécessaire d'activer la feuille 1 dans le classeur1 via le code..

Cordialement

Merci ça semble bien fonctionner ! Par contre j'ai un msgbox qui apparaît et indique "Mémoire insuffisante", de quoi cela pourrait provenir ?

PS: Sélectionner la feuille 1 me permet de revenir sur la Feuil1 du 'Classeur1" après avoir copié/collé sinon on reste sur la Feuil3

Merci beaucoup en tout cas pour votre aide

Jb

Bonjour,

J'ai ajouté : Set xlSheet = Nothing après la fermeture du classeur 2 pour effacer la mémoire temporaire, est-ce correct ?

Bonne journée

JB

Merci ça semble bien fonctionner ! Par contre j'ai un msgbox qui apparaît et indique "Mémoire insuffisante", de quoi cela pourrait provenir ?

C'est Excel qui vous renvoie cela dû à un manque de mémoire pour effectuer l'opération.

Essayez en fermant vos autres programmes éventuellement ouverts. Si le souci reste, fermer excel et relancez le code
Autres points :
- comment vous avez placé les images sur vos feuilles (je ne parle pas des boutons). Avez-vous fait du Copier - Coller ?
- Vos feuilles venant du classeur 2 ont des formules ?

J'ai ajouté : Set xlSheet = Nothing après la fermeture du classeur 2 pour effacer la mémoire temporaire, est-ce correct ?

Pourquoi ? en principe dans le fichier vous n'avez plus de xlsheet puisque je vous ai dit de supprimer cela
L'opération d'importation est d'excel à excel donc pas besoin de mettre ces infos dans vos fichiers. Restez avec ce que je vous ai donné

Edit : Dans votre premier fichier il y avait ceci. Vous pouvez supprimer puisque vos macros ne concernent que deux fichiers excel

Public xlApp As New Excel.Application
Public xlBook As New Excel.Workbook
Public xlSheet As New Excel.Worksheet
Public wbkc As ThisWorkbook

Bonjour Dan,

Pardon, en fait j'ai ajouté : Set wbks = Nothing après la fermeture du classeur 2. Depuis je n'ai plus le souci.

Effectivement j'ai bien supprimé:

Public xlApp As New Excel.Application
Public xlBook As New Excel.Workbook
Public xlSheet As New Excel.Worksheet

Par contre j'ai conservé les variables ci-dessous car je les utilise dans un autre module

Public wbkc As Workbook
Public wbks As Workbook

Ça semble être correct désormais.

Merci à vous

JB

A nouveau,

Aussi, j'ai voulu ajouter un contrôle avant d'afficher le nom des feuilles du "classeur2" dans la listbox du USF du "classeur1".

Je cherche à vérifier que la feuille que je vais copier du "classeur2" vers le "classeur1" est bien présenté en "classeur1" avant de la supprimer du "classeur1".

J'ai donc modifié le code comme ci-après mais désormais ma listbox reste vide. Auriez-vous une idée ?

'Déclare la variable objet Worksheet
Dim Ws,Wsc As Worksheet

For Each Ws In wbks.Worksheets
    If (Ws.Name <> "TEST1" And Ws.Name <> "TEST2"  Then ' on ne pend pas en compte ces 2 feuilles dans la listbox
        For Each Wsc In wbkc.Worksheets 'on boucle sur toutes les feuilles du classeur 1 pour vérifier si la feuille existe avant suppression
            If FeuilleExiste(wbkc.Name) = True Then
                import_OMF.liste_ouvrages.AddItem Ws.Name 'si la feuille est trouvée dans classeur1 alors on pourra copier du classeur2 vers classeur1
            End If
        Next
    End If
Next

Et voici le code placé dans une module:

Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )

On Error GoTo SiErreur
Dim Feuille

    FeuilleExiste = False
    For Each Feuille In Sheets
        If UCase(Feuille.Name) = UCase(FeuilleAVerifier) Then
            FeuilleExiste = True
            Exit Function
        End If
    Next Feuille
Exit Function

SiErreur:
    FeuilleExiste = CVErr(xlErrNA)
End Function

Un grand merci à vous !

JB

Je cherche à vérifier que la feuille que je vais copier du "classeur2" vers le "classeur1" est bien présenté en "classeur1" avant de la supprimer du "classeur1".

Nul besoin d'ajouter ces deux codes. Vous pouvez les supprimer et ensuit dans le code Sub import_data() remplacez :

With wbkc
    .Sheets(nom_ouvrage).Delete  'on supprime du Classeur1 la feuille sélectionné dans le USF

par ceci

With wbkc
    On Error Resume Next
    .Sheets(nom_ouvrage).Delete  'on supprime du Classeur1 la feuille sélectionnée dans le USF
    On Error GoTo 0

Petite remarque et juste pour votre information. Dans votre post et code vous avez ceci

Dim Ws,Wsc As Worksheet

Sachez que la variable "ws" est déclarée en "Variant" et non "Worksheet" comme vous pourriez le penser. Pour une déclaration correcte vous devz écrire comme ceci

Dim Ws as Worksheet,Wsc As Worksheet

Pensez à

A nouveau Dan

Tout d'abord merci pour votre réponse. Je souhaite vérifier au préalable que la feuille qui est dans le "classeur2" est bien présente également dans le "classeur1" avant d'exécuter le reste du code. C'est pour cela que je veux utiliser ce code

'Déclare la variable objet Worksheet
Dim Ws,Wsc As Worksheet

For Each Ws In wbks.Worksheets
    If (Ws.Name <> "TEST1" And Ws.Name <> "TEST2"  Then ' on ne pend pas en compte ces 2 feuilles dans la listbox
        For Each Wsc In wbkc.Worksheets 'on boucle sur toutes les feuilles du classeur 1 pour vérifier si la feuille existe avant suppression
            If FeuilleExiste(wbkc.Ws.Name) = True Then
                import_OMF.liste_ouvrages.AddItem Ws.Name 'si la feuille est trouvée dans classeur1 alors on pourra copier du classeur2 vers classeur1
            End If
        Next
    End If
Next

Je pense que le code bloque sur la ligne ci-dessous mais je ne vois pas comment déclarer autrement:

FeuilleExiste(wbkc.Ws.Name)

PS: Merci pour la précision de la déclaration des variables, je vais corriger de suite !

JB

Je souhaite vérifier au préalable que la feuille qui est dans le "classeur2" est bien présente dans le "classeur1" avant d'exécuter le reste du code.

Quelle importance cela a de vouloir vérifier cela ?
Heu là j'essaie de comprendre le pourquoi ou plutôt le souci que cela peut avoir de ne pas le savoir :

si la feuille est trouvée en classeur 1: vous copiez la feuille du classeur 2 vers le classeur 1
si la feuille n'est pas trouvée en classeur 1 : vous copiez ou pas ?

Expliquez-moi

A nouveau,

si la feuille est trouvée en classeur 1: vous copiez la feuille du classeur 2 vers le classeur 1 => exact
si la feuille n'est pas trouvée en classeur 1 : vous copiez ou pas ? => dans ce cas on n'affiche pas la feuille dans la listbox du USF du Classeur1

Merci beaucoup.

JB

Pour rester dans la même philosophie que le code import_data (ou vous faites le contrôle de l'USF userform1 dans un module), modifiez ceci :

- Dans l'USF, remplacez la sub initialize par celle-ci

Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim j As Integer

For Each ws In wb.Worksheets
    Call Control(j, ws)
Next ws
End Sub

- Dans le module 1, rajoutez ce code

Sub Control(j As Integer, ws As Worksheet)
With wbkc
    For j = 1 To .Sheets.Count
        If .Sheets(j).Name = ws.Name Then
            UserForm1.ListBox1.AddItem ws.Name
        End If
    Next j
End With
End Sub

Edit :

Dans le code Sub MaSub() rajoutez ceci juste avant le END SUB

Set wb = Nothing
Set wbkc = Nothing

A nouveau,

Merci pour cette proposition, je vais coder comme vous le proposez. Je reviendrai solder ce post après mes essais :)

Merci beaucoup !

JB

Bonjour Dan,

C'est parfait, un grand merci, grâce à vous j'ai pu avancer sur mon projet !

Bonne journée

JB