Bouton pour ouvrir un fichier Excel puis copier son contenu

Bonjour,

Je souhaite à partir d'un bouton contenu dans un fichier A,

ouvrir un chemin d'accès pour définir l'adresse du fichier B,

puis copier le contenu du fichier B pour le coller dans le fichier A.

Mais attention le fichier B contient des valeurs sur la plage de cellule variant de la colonne R maximum aux lignes 20 000 maximum... comment puis-je dire que je souhaite que les lignes qui contiennent une/des valeurs sur cette plage ?)

Merci d'avance pour votre aide !

Bonjour Zouarv, bonjour le forum,

Essaie ce code à adapter :

Sub Macro1()
Dim VR As Variant 'déclare la variable VR (Valeur Recerchée)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As FileDialog 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL  As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.ActiveSheet 'définit l'onglet destination OD (à adapter)
Set F = Application.FileDialog(msoFileDialogOpen) 'définit le fichier F
F.Show 'ouvre la bo6ite de dialogue
F.AllowMultiSelect = False 'ne permet la sélection que d'un seul fichier
If F.SelectedItems.Count > 0 Then F.Execute 'si un fichier a été sélectionné, ouvre le fichier
Set CS = ActiveWorkbook 'définit la classeur source CS
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
TV = OS.Range("A1").CurrentRegion 'définuit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
ici: 'étiquette
VR = Application.InputBox("Quelle valeur voulez-vous récupérer ?", "RECHERCHE", Type:=3) 'définit la valeur recherché VR
If VR = "" Or VR = False Then Exit Sub 'si non renseignée ou si bouton[Annuler], sort de la procédure
K = 1 'initialise la variable K
For I = 1 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeur TV
    For J = 1 To NC 'boucle 1 : sur toutes les colonnes J du tableau des valeur TV
        If UCase(TV(I, J)) = UCase(VR) Then 'condition : si la donnée ligne I colonne J de TV convertie en majuscule) est égale à VR (convertie en majuscule)
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 : sur toutes les lignes L de TL
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la données colonne L de TV (= Transposition)
            Next L 'prochaine ligne de la boucle 3
            K = K + 1 'incrémente K 9ajoute une colonne au tablerau des lignes TL
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'définit la cellule de destination DEST (A1, si A1 est vide, sinon, la première cellule vide de la colonne A de l'onglet OD)
Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
If K > 1 Then DEST.Resize(UBound(TL, 2), UBound(TL, 1)) = Application.Transpose(TL) 'si k est supérieure à 1, renvoie dans DEST redimensionnée le tableau TL transposé
If MsgBox("Voulez-vous rechercher une autre valeur ?", vbYesNo, "RECHERCHE") = vbYes Then 'condition si "Oui" au message
    Erase TL 'efface le tableau TL
    GoTo ici 'va à l'étiquette "ici"
End If 'fin de la condition
CS.Close SaveChanges:=False
End Sub

bonjour Thauthème

j'ai tester ton code commenté a souhait mieux on peux pas

l'inputbox s'affiche bien je renseigne la cellule et me demande si je veux saisir autre chose je dit oui et ressaisi puis ferme et la

une seule ligne est remplié au lieu des 2 demandées et renseignées

je cherchais un code de ce type depuis un moment

l'idéal serait un clic sur la ligne pour l'envoyer sur l'autre feuille

Bonjour Thauthème,

Le code marche parfaitement, c'est exactement ce que je cherchais ! Un gros merci !

Si je sélectionne plusieurs ligne (donc un tableau) seul la première ligne est copié, Est-ce normal ? Comment y remédier ? Pour copier/coller l'ensemble de la sélection au sein de la feuille maître...

Bonne journée

Bonjour le fil, bonjour le forum,

Zouarv, tu as été bien avare de commentaires et d'explications. Sans un fichier exemple avec des explications claires je ne peux rien faire de mieux. Ma boule de cristal a des limites...

ThauThème a écrit :

Bonjour le fil, bonjour le forum,

Zouarv, tu a été bien avare de commentaires et d'explications. Sans un fichier exemple avec des explications claires je ne peux rien faire de mieux. Ma boule de cristal a des limites...

bonjour le fil

je suis d'accord avec Thauthème un fichier serai plus explicit que le manque d'explications