Microsoft 365 Récupérer information à partir d'un autre classeur

Daher Ali

XLDnaute Junior
Bonjour le FORUM.

J'ai besoin de votre aide.
Mon classeur comporte 2 feuilles ( Liste Articles et Bon d'entrée )
Le bon d'entrée est remplis grâce à Un userform avec une textbox et Combobox. La saisie dans la textbox me permet de récupérer dynamiquement une Liste Articles dans la Combobox, lorsque le choix d'articles est fait je valide. Jusque là le travail est fait.
Je voudrais que la Feuille "Liste Articles" ne ce trouve pas dans un même classeur avec Feuille "Bon Entree" donc dans un nouveau classeur et que je puisse récupérer la Liste Article toujours dans le même userform du premier classeur et valider mon Bon Entrée.
Merci de m'aider svp :)
 
Solution
oK

J'ai testé, celà fonctionne, mais c'est un peu lourdingue d'envoyer la recherche dès le début de l'input d'un caractères :

1594547362793.png


J'ajouterais une condition :
VB:
    If TxtRecherche <> "" Then
        If Len(Me.TxtRecherche) >= 4 Then
          For Ligne = 2 To NbLigne
             If WS.Cells(Ligne, 2) Like "*" & TxtRecherche & "*" Then
                Me.Cont3.AddItem WS.Cells(Ligne, 2)
             End If
          Next Ligne
        End If
    End If

Pour qu'il ne réponde "que" ceci et pas avant 4 caractères saisis : (inutile "d'affoler" le système !!!)

1594547635316.png


Après pour ActiveSheet, je t'avais dit ce que j'en pensais...

Finalement tu as déjà ouvert manuellement le Workbooks("Articles.xlsx") donc oui...

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir @Daher Ali , le Forum

Pour faire ceci il faut déclarer proprement les Classeurs en jeu, et faire les "Sets" d'objets adéquates..

Un exemple, pour copier une feuille d'un classeur à un autre, mais ce sera le même principe...

VB:
Option Explicit

Sub CopySheet_If_Both_WorkBook_Open()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS As Worksheet

Set WB1 = ThisWorkbook
Set WB2 = Workbook("Classeur2.xlsm")
Set WS = WB1.Worksheets("Feuil1")

WS.Copy Before:=WB2.Worksheets(1)

End Sub



Sub CopySheet_To_Closed_WorkBook()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS As Worksheet
Dim FullPath As String

Set WB1 = ThisWorkbook
Set WS = WB1.Worksheets("Feuil1")

FullPath = WB1.Path & "\Classeur2.xlsm"

Set WB2 = Workbooks.Open(FullPath)
WS.Copy Before:=WB2.Worksheets(1)
WB2.Close True


End Sub

Bonne soirée
@+Thierry
 

Daher Ali

XLDnaute Junior
Bonsoir @Daher Ali , le Forum

Pour faire ceci il faut déclarer proprement les Classeurs en jeu, et faire les "Sets" d'objets adéquates..

Un exemple, pour copier une feuille d'un classeur à un autre, mais ce sera le même principe...

VB:
Option Explicit

Sub CopySheet_If_Both_WorkBook_Open()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS As Worksheet

Set WB1 = ThisWorkbook
Set WB2 = Workbook("Classeur2.xlsm")
Set WS = WB1.Worksheets("Feuil1")

WS.Copy Before:=WB2.Worksheets(1)

End Sub



Sub CopySheet_To_Closed_WorkBook()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS As Worksheet
Dim FullPath As String

Set WB1 = ThisWorkbook
Set WS = WB1.Worksheets("Feuil1")

FullPath = WB1.Path & "\Classeur2.xlsm"

Set WB2 = Workbooks.Open(FullPath)
WS.Copy Before:=WB2.Worksheets(1)
WB2.Close True


End Sub

Bonne soirée
@+Thierry
Bonsoir Thierry,

Merci beaucoup pour votre retour ci rapide et efficace, problème résolu juste qu'il manquait un "S" à la fin de workbooks dans cette instruction : Set WB2 = Workbook("Classeur2.xlsm").

J'aimerais savoir stp et si je veux préciser le dossier du deuxième classeur pour ne pas confondre avec d'autre classeur qui pourrons comporter le même nom. Comment sera le code en ce moment.

Encore Merci à toi Thierry et le Forum
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @Daher Ali , le Forum

Heureux d'avoir pu te mettre sur la piste et sorry pour le "s" manquant dans le set WB2 !

Pour ceci :
J'aimerais savoir stp et si je veux préciser le dossier du deuxième classeur pour ne pas confondre avec d'autre classeur qui pourrons comporter le même nom. Comment sera le code en ce moment.

Oui il faut indiquer le chemin complet :
FullPath = "C:\Users\Thierry\Documents\XLD\Daher_Ali\Classeur2.xlsm"
(Voir exemple de code plus bas)

Et pour celà :
Désolé autre chose encore, et si le classeur est fermer dois l'ouvrir obligatoire pourque ma macro marche, si oui stp comment le faire aussi ?

Oui il vaut mieux avoir le classeur ouvert, sinon il y a des méthodes ("ADO" par exemple) pour travailler sur fichiers fermés, mais c'est assez compliqué. Ouvrir le classeur, le modifier et le fermer en le sauvant (WB2.Close True) reste l'option la plus simple comme dans cet exemple :

VB:
Sub CopySheet_To_Closed_WorkBook()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS As Worksheet
Dim FullPath As String

Set WB1 = ThisWorkbook
Set WS = WB1.Worksheets("Feuil1")

FullPath = "C:\Users\Thierry\Documents\XLD\Daher_Ali\Classeur2.xlsm"

Set WB2 = Workbooks.Open(FullPath)
WS.Copy Before:=WB2.Worksheets(1)
WB2.Close True

End Sub


Tant que WB2 est ouvert tu peux travailler dessus depuis ton UserForm... Comme si c'était le même classeur mais en appelant systématiquement WB2.Worksheets("toto").Range("A1") etc ...


Bonne journée
@+Thierry
 

Daher Ali

XLDnaute Junior
Bonsoir Thierry,
J'ai indiqué le chemin complet et le set qui ouvre le classeur cela est bon mais lorsque je veux valide les données dans le userform il les place dans ce classeur qui vient de s'ouvrir et moi je veux le contraire juste récupérer des info et valider dans le classeur de base.
Et autre chose j'aimerais lorsque ce classeur s'ouvre ne s'affiche pas a l'écran pour ne pas le réduire et revenir sur le userform si possible sinon je me débrouillerai.
Merci.
Si mon explication est flou veux-tu que j'écrive mon code pour le voir ?
 

Daher Ali

XLDnaute Junior
Bonsoir @Daher Ali

Oui peut-être de voir le code peut aider pour comprendre ce qui ne va pas... Surtout celui du Userform.

Bonne soirée
@+Thierry
Joint le code :

VB:
Private Sub TxtRecherche_Change()
    Dim NbLigne As Long
    Dim Ligne As Long
    Dim WB2 As Workbook
    Dim WS As Worksheet
    Dim FullPath As String
        
    FullPath = "C:\Users\ALI\Desktop\EXCEL ALI\Bon Entree & Liste Articles\Liste Articles\Articles.xlsx"
    
    Set WB2 = Workbooks.Open(FullPath)
    
    Set WB2 = Workbooks("Articles.xlsx")
    Set WS = WB2.Worksheets("ListeArticles")
    
    Cont3.Clear
    
    NbLigne = Application.WorksheetFunction.CountA(WS.Range("B:B"))

    If TxtRecherche <> "" Then
      For Ligne = 2 To NbLigne
         If WS.Cells(Ligne, 2) Like "*" & TxtRecherche & "*" Then
            Me.Cont3.AddItem WS.Cells(Ligne, 2)
         End If
      Next Ligne
    End If
End Sub
 

Daher Ali

XLDnaute Junior
j'explique, cette textebox me permet de récupérer des infos à partir de ce chemin d'accès pour cela je dois ouvrir le classeur fermer ensuite récupérer l'info et lorsque je valide, la saisie ce fait dans le classeur source pas celui qui s'ouvre.
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re

Je corrigerai le code comme suit :

VB:
Private Sub TxtRecherche_Change()
    Dim NbLigne As Long
    Dim Ligne As Long
    Dim WBCible As Workbook, WBSource As Workbook
    Dim WSCible As Worksheet, WSCible As Worksheet
    Dim FullPath As String
   
    Application.ScreenUpdating = False 'Comme ça on ne voit rien se passer ...
   
    FullPath = "C:\Users\ALI\Desktop\EXCEL ALI\Bon Entree & Liste Articles\Liste Articles\Articles.xlsx"
   
    Set WBCible = ThisWorkbook
    Set WSCible = WBCible.Worksheets("Le Nom de ta Feuille Cible")
   
   
    Set WBSource = Workbooks.Open(FullPath)
   
''''    Set WBSource = Workbooks("Articles.xlsx") '<<<<<<<<<  PAS LA PEINE LE SET EST DEJA FAIT !
    Set WSSource = WBSource.Worksheets("ListeArticles")
   
    Cont3.Clear
   
    NbLigne = Application.WorksheetFunction.CountA(WSSource.Range("B:B"))

    If TxtRecherche <> "" Then
      For Ligne = 2 To NbLigne
         If WSSource.Cells(Ligne, 2) Like "*" & TxtRecherche & "*" Then
            Me.Cont3.AddItem WSSource.Cells(Ligne, 2)
         End If
      Next Ligne
    End If

WBSource.Close False 'ON FERME SANS SAUVER

'Si tu dois écrire sur la Feuille Cible ce serait comme suit (le BOUTON VALIDATION)
For i = 1 To Me.Cont3.ListCount - 1
    WSCible.Cells(i, 1) = Me.Cont3.List(i)
Next i

    Application.ScreenUpdating = True


End Sub

Ici j'ai tout mis dans le TxtRecherche_Change, mais je supppose que tu as un CommandButton de Validation... Donc la WSCible sera plutôt déclarée et exploitée là bas...

Bonne découverte
@+Thierry
 

Daher Ali

XLDnaute Junior
Re

Je corrigerai le code comme suit :

VB:
Private Sub TxtRecherche_Change()
    Dim NbLigne As Long
    Dim Ligne As Long
    Dim WBCible As Workbook, WBSource As Workbook
    Dim WSCible As Worksheet, WSCible As Worksheet
    Dim FullPath As String
  
    Application.ScreenUpdating = False 'Comme ça on ne voit rien se passer ...
  
    FullPath = "C:\Users\ALI\Desktop\EXCEL ALI\Bon Entree & Liste Articles\Liste Articles\Articles.xlsx"
  
    Set WBCible = ThisWorkbook
    Set WSCible = WBCible.Worksheets("Le Nom de ta Feuille Cible")
  
  
    Set WBSource = Workbooks.Open(FullPath)
  
''''    Set WBSource = Workbooks("Articles.xlsx") '<<<<<<<<<  PAS LA PEINE LE SET EST DEJA FAIT !
    Set WSSource = WBSource.Worksheets("ListeArticles")
  
    Cont3.Clear
  
    NbLigne = Application.WorksheetFunction.CountA(WSSource.Range("B:B"))

    If TxtRecherche <> "" Then
      For Ligne = 2 To NbLigne
         If WSSource.Cells(Ligne, 2) Like "*" & TxtRecherche & "*" Then
            Me.Cont3.AddItem WSSource.Cells(Ligne, 2)
         End If
      Next Ligne
    End If

WBSource.Close False 'ON FERME SANS SAUVER

'Si tu dois écrire sur la Feuille Cible ce serait comme suit (le BOUTON VALIDATION)
For i = 1 To Me.Cont3.ListCount - 1
    WSCible.Cells(i, 1) = Me.Cont3.List(i)
Next i

    Application.ScreenUpdating = True


End Sub

Ici j'ai tout mis dans le TxtRecherche_Change, mais je supppose que tu as un CommandButton de Validation... Donc la WSCible sera plutôt déclarée et exploitée là bas...

Bonne découverte
@+Thierry
Tu est génial Thierry, je vais tester cela et te revenir
joint le code de validation :

VB:
Private Sub CmdAjouter_Click()

    Dim nbControle As Integer
    Dim NouvelleLigne As Range
    Dim MaFeuille As String
    
    If Me.Cont1 = "" Or Me.Cont2 = "" Or Me.Cont3 = "" Or Me.Cont4 = "" Then
          MsgBox "Toutes les informations ne sont pas remplies....!", _
                 vbOKOnly + vbInformation, "VALIDATION"
    
    Else
    
    MaFeuille = ActiveSheet.Name
    
    nbControle = 4
    
          If Sheets(MaFeuille).Range("A2") = "" Then
          
             'On se positionne sur la dernière ligne vide de la table de données
             Set NouvelleLigne = Sheets(MaFeuille).Cells(Rows.Count, 1).End(xlUp)
    
             For x = 1 To nbControle
                Cont1 = Format(Cont1, "General Number")
                Cont2 = Format(Cont2, "General Number")
                Cont4 = Format(Cont4, "General Number")
                NouvelleLigne = Me.Controls("Cont" & x).Value
                Set NouvelleLigne = NouvelleLigne.Offset(0, 1)
             Next x
            
          Else
          
             Set NouvelleLigne = Sheets(MaFeuille).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
             For x = 1 To nbControle
                Cont1 = Format(Cont1, "General Number")
                Cont2 = Format(Cont2, "General Number")
                Cont4 = Format(Cont4, "General Number")
                NouvelleLigne = Me.Controls("Cont" & x).Value
                Set NouvelleLigne = NouvelleLigne.Offset(0, 1)
             Next x

          End If
    
        For x = 1 To nbControle
        Me.Controls("Cont" & x).Value = ""
        Next x
    
        MsgBox "La nouvelle saisie a bien été ajoutée sur la feuille : " _
               & MaFeuille, vbOKOnly + vbInformation, "CONFIRMATION"

   End If
            
End Sub
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Pas sûr de comprendre ce que tu fais... En fait je ne vois pas où tu écris sur WSCible ?

Mais bon ca donnerait ceci (sans tester)

VB:
Private Sub CmdAjouter_Click()
    Dim WBCible As Workbook
    Dim WSCible As Worksheet

    Dim nbControle As Integer
    Dim NouvelleLigne As Range
    Dim MaFeuille As String
    
    If Me.Cont1 = "" Or Me.Cont2 = "" Or Me.Cont3 = "" Or Me.Cont4 = "" Then
          MsgBox "Toutes les informations ne sont pas remplies....!", _
                 vbOKOnly + vbInformation, "VALIDATION"
    
    Else
        
'''''    MaFeuille = ActiveSheet.Name  '<<<< pas bon, on ne sait jamais qu'elle est la feuille active...
    Set WBCible = ThisWorkbook
    Set WSCible = WBCible.Worksheets("Le Nom de ta Feuille Cible")

    
    
    nbControle = 4
    
          If WBCible.Range("A2") = "" Then
          
             'On se positionne sur la dernière ligne vide de la table de données
             Set NouvelleLigne = WBCible.Cells(Rows.Count, 1).End(xlUp)
    
             For x = 1 To nbControle
                Cont1 = Format(Cont1, "General Number")
                Cont2 = Format(Cont2, "General Number")
                Cont4 = Format(Cont4, "General Number")
                NouvelleLigne = Me.Controls("Cont" & x).Value
                Set NouvelleLigne = NouvelleLigne.Offset(0, 1)
             Next x
            
          Else
          
             Set NouvelleLigne = WBCible.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
             For x = 1 To nbControle
                Cont1 = Format(Cont1, "General Number")
                Cont2 = Format(Cont2, "General Number")
                Cont4 = Format(Cont4, "General Number")
                NouvelleLigne = Me.Controls("Cont" & x).Value
                Set NouvelleLigne = NouvelleLigne.Offset(0, 1)
             Next x

          End If
    
        For x = 1 To nbControle
        Me.Controls("Cont" & x).Value = ""
        Next x
    
        MsgBox "La nouvelle saisie a bien été ajoutée sur la feuille : " _
               & WBCible.Name, vbOKOnly + vbInformation, "CONFIRMATION"

   End If
            
End Sub

Bonne nuit
@+Thierry
 

Daher Ali

XLDnaute Junior
Bonjour Thierry,
vous êtes formidable, c'est bien ce que je cherchais mais j'ai effectuer quelque modification.
J'ai supprimer cette ligne de code :
WBSource.Close False 'ON FERME SANS SAUVER 'Si tu dois écrire sur la Feuille Cible ce serait comme suit (le BOUTON VALIDATION) For i = 1 To Me.Cont3.ListCount - 1 WSCible.Cells(i, 1) = Me.Cont3.List(i) Next i
Car je ne veux pas fermer tout de suite le classeur WBSource tant que je ne n'est pas fini toute les saisies, et le FOR supprimer pour éviter de prendre toute les ligne de la feuille :
Set WSSource = WBSource.Worksheets("ListeArticles")

j'explique :
- les mots saisie dans la TxtRecherche me donne une liste dynamique de la ListeArticles dans ma Cont3 ( qui est une Combobox ) ,je selectionne un article voulu dans cette Cont3 et je valide. Apres validation le Userform ce vide pour ensuite faire une autre saisie.

''''' MaFeuille = ActiveSheet.Name '<<<< pas bon, on ne sait jamais qu'elle est la feuille active... Set WBCible = ThisWorkbook Set WSCible = WBCible.Worksheets("Le Nom de ta Feuille Cible")
Ce qui concerne ActiveSheet.Name je les mise car je peux avoir dans le Classeur WBCible plusieurs Bon d'Entrées, je joint mes 2 classeurs celui des Bon d'entrées et Liste Articles que j'avais fait peux être que mon explication n'est pas au top :confused:
 

Pièces jointes

  • Bon Entree.xlsm
    38.3 KB · Affichages: 10
  • Articles.xlsx
    28.3 KB · Affichages: 4

Discussions similaires