Sujet Précédent Sujet Suivant

UserForm insérer contenu de 2 feuil dans une autre feuil de classeur différent

Résolu/Fermé
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 - 13 mai 2021 à 13:56
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 - 14 mai 2021 à 12:03
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
A voir également:

10 réponses

Réponse 1 / 10
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
13 mai 2021 à 18:02
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
1
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
Modifié le 13 mai 2021 à 19:38
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é
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
13 mai 2021 à 20:37
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
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
Modifié le 13 mai 2021 à 21:04
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.
0
Réponse 2 / 10
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
Modifié le 13 mai 2021 à 16:02
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....!

0
Réponse 3 / 10
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
13 mai 2021 à 16:30
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
0
Réponse 4 / 10
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
Modifié le 13 mai 2021 à 21:32
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 10
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
Modifié le 14 mai 2021 à 09:26
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)
.
0
Réponse 6 / 10
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
Modifié le 14 mai 2021 à 10:13
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
0
Réponse 7 / 10
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
Modifié le 14 mai 2021 à 11:08
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
0
Réponse 8 / 10
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
Modifié le 14 mai 2021 à 11:21
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
0
Réponse 9 / 10
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
14 mai 2021 à 11:41
Bonjour,
Je constate que vous n'avez pas fait les corrections indiquées au poste 7.

0
Réponse 10 / 10
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
Modifié le 14 mai 2021 à 11:54
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
0
Le Pingou Messages postés 12240 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 11 février 2025 1 457
14 mai 2021 à 12:03
Merci, content pour vous .
Mettre en résolu si c'est le cas
Salutations.
Le Pingou
0

Discussions similaires

Voxbone ? qui est-ce ?
fanfan54 -
djakool4 -

158 réponses
comment faire "différent de" sous excel/
UsulArrakis -
Lizs -

11 réponses
NB.SI.ENS Différent de
nicolas4107 -
Vaucluse -

5 réponses
Excel formule : nb.si.ens et critère "différent de vide"
lelion4 -
Mick -

11 réponses