UserForm insérer contenu de 2 feuil dans une autre feuil de classeur différent [Résolu]

Signaler
Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
-
Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
-
Bonjour à tous,

J'ai besoin de votre pour terminer le développement de ma macro car je sèche totalement malgré mes recherches.

Je travaille sur un "UserForm" avec "Application.GetOpenFilename" et "fmMultiSelectMulti" pour selectionner plusieurs onglets.Jusqu'à la impec tout fonctionne!!!

Mais après cela se complique par la suite... lol

1 / Avec les 2 onglets sélectionnés, Je souhaiterais copier leur contenu en ("B1:C53") .

2/ Je souhaiterais coller les contenus dans une seule feuil du classeur source ("Menu"):
Premier onglet copier : coller en ("B1:C53")
Deuxième onglet copier : coller en ("D1:E53")

Je vous colle mon début de travail:

Option Explicit
Public wbks As Workbook
Public wbkc As Workbook
Public feuil$


Sub userform_initialize()

'--- Déclaration des variables
Dim choix$, Ws As Worksheet, feuil$, x$

'--- Génération de la liste des onglets

Set wbks = ThisWorkbook
'MsgBox ("Selectionner le fichier à importer dans ce classeur")
choix = Application.GetOpenFilename("Fichiers Excel (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")
'If choix = "" Then Exit Sub Else Set wbks = Workbooks.Open(choix)
If VarType(choix) = vbBoolean Then Exit Sub Else Set wbks = Workbooks.Open(choix)


With ListBox2
.MultiSelect = fmMultiSelectMulti
.Clear

For Each Ws In wbks.Worksheets
RechercheMenu.ListBox2.AddItem Ws.Name
Next Ws

End With
End Sub



'Action quand on clique sur le Bouton "Créer"
Private Sub CommandButton1_Click()

'--- Déclaration des variables
Dim I As Integer
Dim Feuille() As Variant
Dim NbFeuille As Integer
Dim Fichier As Variant, tampon

'--- Copier/coller des onglets sélectionnés
With ListBox2
For I = 0 To .ListCount - 1
If .Selected(I) Then
ReDim Preserve Feuille(NbFeuille)
Feuille(NbFeuille) = .List(I)
NbFeuille = NbFeuille + 1
End If
Next I
End With
Unload Me

'--- Copier/coller le contenu des feuils

With Sheets(Feuille)

'!!!Bon la je sèche completement!!!!!!
' ???Copier onglet1 et onglet2 et coller dans la feuil ("Menu")du classeur source???

End With


End Sub


Bon je n'arrive absolument pas à écrire ma 2ème procédure CommandButton1_Click()

Merci de votre aide et vos nouvelles idées.....

Configuration: Windows / Chrome 90.0.4430.212

10 réponses

Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Bonjour,
Essayer comme suit:
'--- Copier/coller des onglets sélectionnés
With ListBox2
d = 0
For I = 0 To .ListCount - 1
If .Selected(I) Then
Workbooks("alexchoix.xlsx").Sheets(.List(I)).Range("A1:B53").Copy Workbooks("alex.xlsm").Sheets("Feuil1").Range("b1").Offset(0, d)
d = d + 2
End If
Next I
End With
Unload Me

Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
Merci à toi pour ton aide

Je n'ai pas essayé le code car je m'aperçois que tu as ciblé des noms de classeur. Or les noms sont variables c'est pour cela que j'avais déclaré les variables suivantes:
Public wbks As Workbook
Public wbkc As Workbook


WBKS : le classeur ouvert qui contient la macro et ou l'on colle le contenu dans Sheets("Menu")
WBKC : le classeur a ouvrir avec Application.GetOpenFilename pour copier le contenu des 2 onglets

Par contre le nom de la feuil de destination est toujours la meme :
Sheets("Menu")


et la variable "D" = 0 n 'est pas déclaré
Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
Pour la déclaration de la variable j'ai ajouter
Dim d As Integer


Par contre j'ai beau y tortiller dans tous les sens mais je ne trouve pas de solution sans nommer les classeurs actifs
Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
Bon voila je vous apporte ma réponse qui peut aider d'autres utilisateurs. Elle n'est pas la meilleure mais elle fonctionne...

Workbooks(Workbooks.Count).Sheets(.List(I)).Range("B1:C53").Copy Workbooks(1).Sheets("Feuil1").Range("b1:C53").Offset(0, d)


Workbooks(Workbooks.Count)
pour le dernier classeur ouvert

Workbooks(1)
pour le premier classeur ouvert

Un grand merci LePingou pour ton aide bien précieuse.
Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Bonjour,
juste au passage: dans votre code CommandButton1_Click vous avez mis l'instruction Unload Me qui ferme le formulaire et donc vous perdez le contenu de la variable Feuille....!

Salutations.
Le Pingou
Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Bonjour,
Il vous suffit de compléter votre code selon les informations
With ListBox2
For I = 0 To .ListCount - 1
If .Selected(I) Then
' copier les données (b1:c53) de la feuille selon List(I)
'Premier passage:
'les coller sur classeur source, feuille 1 plage B1:C53
'deuxième passage
'les coller sur classeur source, feuille 1 plage D1:E53
End If
Next I
End With


Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Bonjour,
Est-ce que le classeur actif est celui que vous choisissez dans "choix = Application.GetOpenFilename
Si Oui alors modifier ma ligne d'instruction comme suit:
For I = 0 To .ListCount - 1
If .Selected(I) Then
WBKC.Sheets(.List(I)).Range("A1:B53").Copy WBKS.Sheets("Menu").Range("b1").Offset(0, d)
' *** ancien code.......Workbooks("alexchoix.xlsx").Sheets(.List(I)).Range("A1:B53").Copy Workbooks("alex.xlsm").Sheets("Feuil1").Range("b1").Offset(0, d)
d = d + 2
..........
..........
End If

Et en plus corriger votre code : remplacer WBKS par WBKC
  'If choix = "" Then Exit Sub Else Set wbks = Workbooks.Open(choix)
If VarType(choix) = vbBoolean Then Exit Sub Else Set WBKS= Workbooks.Open(choix)

et aussi ici:
For Each Ws In WBKS.Worksheets
RechercheMenu.ListBox2.AddItem Ws.Name
Next Ws


Salutations.
Le Pingou
Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
Le seul classeur actif (wbks) est celui qui contient la macro . Le second classeur (wbkc) n'est pas ouvert et devient actif après l'instruction
choix = Application.GetOpenFilename


Cette ligne de code pose soucis. J'avais déjà tenter cette écriture mais cela crée un bug "l'indice n'appartient pas à la sélection"
wbkc.Sheets(.List(I)).Range("B1:C53").Copy wbks.Sheets("Menu").Range("B1").Offset(0, d)


J'ai donc du ajouter les écriture suivante:
Set wbks = ThisWorkbook
Set wbkc = Workbooks(Workbooks.Count)


Au final je suis toujours obligé d'écrire
Workbooks(Workbooks.Count)
.
Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
Bon j'ai réécrit mon code en rajoutant une petite condition pour sélectionner que 4 items maxi.

Private Sub CommandButton1_Click()

'Déclaration des variables
Dim I As Integer
Dim d As Integer
Dim a As Integer

Set wbks = ThisWorkbook
Set wbkc = Workbooks(Workbooks.Count)

'Copier/coller des onglets sélectionnés

With ListBox2
d = 0
For I = 0 To .ListCount - 1: If ListBox2.Selected(I) Then wbkc.Sheets(.List(I)).Range("B1:C53").Copy wbks.Sheets("Menu").Range("B1").Offset(0, d)
d = d + 2
'Décalage de 2 colonnes

' Selection de 4 items maximum

If a > 4 Then ListBox2.Selected(ListBox2.ListIndex) = False: MsgBox "Vous ne pouvez pas sélectionner plus de 4 menus"

Next I
End With

Unload Me
Workbooks(Workbooks.Count).Close

End Sub
Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Bonjour,
C'est étonnant car chez moi cela fonctionne correctement .
Avez-vous bien corrigé votre code les 2 parties que j'ai cité pour WBKS par WBKC?
Ces 2 lignes sont inutiles:
Set wbks = ThisWorkbook
Set wbkc = Workbooks(Workbooks.Count)
car vous avez déjà réalisé dans votre code.
Mon fichier d'essai : https://www.cjoint.com/c/KEojh2vDFd0
Salutations.
Le Pingou
Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
Bonjour,

Je remets l'intégralité du code tel qu'il est...
Si je n'ajoute ces 2 ligne
Set wbks = ThisWorkbook
Set wbkc = Workbooks(Workbooks.Count)
ca bug!

Public wbks As Workbook
Public wbkc As Workbook
Public feuil$
'--------------------------------------------------------------
Sub userform_initialize()

'Déclaration des variables
Dim choix$, Ws As Worksheet, feuil$, x$

Application.EnableEvents = False
Sheets("Menu").Cells.Select
Selection.ClearContents
Application.EnableEvents = True

'Génération de la liste des onglets

    Set wbks = ThisWorkbook
    choix = Application.GetOpenFilename("Fichiers Excel (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")
    If VarType(choix) = vbBoolean And Sheets("Sommaire").Select Then Exit Sub Else: Set wbks = Workbooks.Open(choix)
    
    With ListBox2
    .MultiSelect = fmMultiSelectMulti
    .Clear
    
    For Each Ws In wbks.Worksheets     '!!! "wbkc" n'affiche pas la bonne liste!!!
        RechercheMenu.ListBox2.AddItem Ws.Name
    Next Ws
    
    End With

End Sub

'------------------------------------------------------------------
'Action quand on clique sur le Bouton "Créer"
Private Sub CommandButton1_Click()

    Dim I As Integer
    Dim d As Integer
    Dim a As Integer

    Set wbks = ThisWorkbook
    Set wbkc = Workbooks(Workbooks.Count)

'Copier/coller des onglets sélectionnés
    With ListBox2
        d = 0
        For I = 0 To .ListCount - 1: If ListBox2.Selected(I) Then wbkc.Sheets(.List(I)).Range("B1:C53").Copy wbks.Sheets("Menu").Range("B1").Offset(0, d)
        d = d + 2

        If a > 4 Then ListBox2.Selected(ListBox2.ListIndex) = False: MsgBox "Vous ne pouvez pas sélectionner plus de 4 menus"

        Next I
    End With
  
    Unload Me
    Workbooks(Workbooks.Count).Close

End Sub
Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Bonjour,
Je constate que vous n'avez pas fait les corrections indiquées au poste 7.

Messages postés
49
Date d'inscription
vendredi 5 avril 2013
Statut
Membre
Dernière intervention
14 mai 2021
2
mi aculpa...ca fonctionne beaucoup mieux comme ca!!!
Milles remerciements Le Pingou

Je remets l'intégralité du code si cela peut aider d'autres utilisateurs

Option Explicit
Public wbks As Workbook
Public wbkc As Workbook
Public feuil$

Sub userform_initialize()

'Déclaration des variables
Dim choix$, Ws As Worksheet, feuil$, x$

Application.EnableEvents = False
Sheets("Menu").Cells.Select
Selection.ClearContents
Application.EnableEvents = True

'Génération de la liste des onglets

    Set wbks = ThisWorkbook
    choix = Application.GetOpenFilename("Fichiers Excel (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")
    If VarType(choix) = vbBoolean And Sheets("Sommaire").Select Then Exit Sub Else: Set wbkc = Workbooks.Open(choix)
    
    With ListBox2
    .MultiSelect = fmMultiSelectMulti
    .Clear
    
    For Each Ws In wbkc.Worksheets
        RechercheMenu.ListBox2.AddItem Ws.Name
    Next Ws
    
    End With

End Sub

'Action quand on clique sur le Bouton "Créer"
Private Sub CommandButton1_Click()

    Dim I As Integer
    Dim d As Integer
    Dim a As Integer

'Copier/coller des onglets sélectionnés
    With ListBox2
        d = 0
        For I = 0 To .ListCount - 1: If ListBox2.Selected(I) Then wbkc.Sheets(.List(I)).Range("B1:C53").Copy wbks.Sheets("Menu").Range("B1").Offset(0, d)
        d = d + 2

        If a > 4 Then ListBox2.Selected(ListBox2.ListIndex) = False: MsgBox "Vous ne pouvez pas sélectionner plus de 4 menus"

        Next I
    End With
  
    Unload Me
    Workbooks(Workbooks.Count).Close

End Sub
Messages postés
10059
Date d'inscription
mercredi 11 août 2004
Statut
Contributeur
Dernière intervention
14 juin 2021
1 149
Merci, content pour vous .
Mettre en résolu si c'est le cas
Salutations.
Le Pingou