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

Résolu

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention -
Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention - 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

Afficher la suite

A voir également:

UserForm insérer contenu de 2 feuil dans une autre feuil de classeur différent
Insérer une vidéo dans powerpoint - Guide
Supercopier 2 - Télécharger - Gestion de fichiers
Insérer signature word - Guide
Comment insérer des points de suite sur word - Guide
Insérer liste déroulante excel - Guide

10 réponses

Réponse 1 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention 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é

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention 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

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention 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.

Réponse 2 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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....!

Réponse 3 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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

Réponse 4 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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

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 Statut Membre Dernière intervention 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)

Réponse 6 / 10

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention 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

Réponse 7 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

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

Réponse 8 / 10

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention 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

Réponse 9 / 10

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
Je constate que vous n'avez pas fait les corrections indiquées au poste 7.

Réponse 10 / 10

alex141077 Messages postés 52 Date d'inscription Statut Membre Dernière intervention 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

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Merci, content pour vous .
Mettre en résolu si c'est le cas
Salutations.
Le Pingou

Discussions similaires

Excel formule : nb.si.ens et critère "différent de vide"

Votre réponse

Discussions similaires