[Excel] Faire une Extraction en choisissant le fichier et la feuille d'ou l'on eRésolu

Question

Bonjour à toutes et à tous,

Actuellement, mon code me permet d'extraire les informations contenues dans une feuille excel ( formulaire ), afin de les ajouter à une autre feuille excel ( Base de Données ). Les 2 feuilles se trouvent dans le même classeur.

Le code ressemble à ca :

Sub Extraire()
    marecherche = Sheets("FIQ").Range("Y2").Value
    With Sheets("BDD").Range("a:a")
       Set c = .find(marecherche, LookIn:=xlValues)
        If c Is Nothing Then
        Call copie
        End If
    End With
End Sub

Sub copie()


Dim ProchaineLigneVide As Integer
With Sheets("BDD")
    ProchaineLigneVide = .Range("A65536").End(xlUp).Row + 1
    .Range("A" & ProchaineLigneVide).Value = Sheets("FIQ").Range("Y2").Value
    .Range("B" & ProchaineLigneVide).Value = Sheets("FIQ").Range("A9").Value
    .Range("C" & ProchaineLigneVide).Value = Sheets("FIQ").Range("I8").Value
    .Range("D" & ProchaineLigneVide).Value = Sheets("FIQ").Range("S10").Value
    .Range("E" & ProchaineLigneVide).Value = Sheets("FIQ").Range("S12").Value
End With

End Sub

La macro extraire permet de ne pas avoir de doublons, et la macro copie permet d'extraire les informations.

Ce que je souhaite faire, est de pouvoir choisir la feuille et le classeur d'ou extraire les informations.
En gros, le formulaire est standard.
Il faudrait faire quelque chose qui ressemble à un "parcourir", mais la , je ne sais pas comment faire.

Pouvez vous m'aider s'il vous plait.

Cordialement,

AiDuK

mortalino · Accepted Answer

Salut, '----------------------- a virer --------------------- With Sheets("BDD") ProchaineLigneVide = .Range("A65536").End(xlUp).Row + 1 .Range("A" & ProchaineLigneVide).Value = Sheets("FIQ").Range("Y2").Value .Range("B" & ProchaineLigneVide).Value = Sheets("FIQ").Range("B8").Value .Range("C" & ProchaineLigneVide).Value = Sheets("FIQ").Range("J7").Value .Range("D" & ProchaineLigneVide).Value = Sheets("FIQ").Range("O9").Value .Range("E" & ProchaineLigneVide).Value = Sheets("FIQ").Range("S11").Value .Range("F" & ProchaineLigneVide).Value = Sheets("FIQ").Rang("A13").Value .Range("G" & ProchaineLigneVide).Value = Sheets("FIQ").Range"V15").Value .Range("H" & ProchaineLigneVide).Value = Sheets("FIQ").Range"T13").Value End With '----------------------- a virer --------------------- With ThisWorkBook .Sheets("BDD") ProchaineLigneVide = .Range("A65536").End(xlUp).Row + 1 .Range("A" & ProchaineLigneVide).Value = ActiveWorkBook .Sheets("FIQ").Range("Y2").Value .Range("B" & ProchaineLigneVide).Value = ActiveWorkBook.Sheets("FIQ").Range("B8").Value .Range("C" & ProchaineLigneVide).Value = ActiveWorkBook .Sheets("FIQ").Range("J7").Value .Range("D" & ProchaineLigneVide).Value = ActiveWorkBook.Sheets("FIQ").Range("O9").Value .Range("E" & ProchaineLigneVide).Value = ActiveWorkBook .Sheets("FIQ").Range("S11").Value .Range("F" & ProchaineLigneVide).Value = ActiveWorkBook.Sheets("FIQ").Rang("A13").Value .Range("G" & ProchaineLigneVide).Value = ActiveWorkBook .Sheets("FIQ").Range"V15").Value .Range("H" & ProchaineLigneVide).Value = ActiveWorkBook.Sheets("FIQ").Range"T13").Value End With ~ Mortalino ~ [code.aspx?ID=39466 Colorisation automatique] @++ le mystérieux chevalier,"Provençal, le gaulois" Forum Office & VBA

bigfish_le vrai · Answer

Salut,

la fonction GetOpenFilename devrait faire l'affaire.

Sub OuvrirFichierExcel()
    Dim FileToOpen As String
    FileToOpen = Application.GetOpenFilename("Tout les fichiers Excel (*.xl*;*.xls;*.xla;*.xml;*.xlm;*.xlc;*.xlw),")
    'si l'utilisateur clique sur le bouton Cancel FileToOpen sera = a false
    'donc si FileToOpen n'est pas = a false on ouvre le fichier
    If Not FileToOpen = False Then Workbooks.Open FileToOpen 
End Sub

Dans ce cas la variable FileToOpen contient le chemin + le nom du fichier selectionné.

A+

AiDuK · Answer

Merci d'avoir pris le temps de répondre à ma question, cependant j'ai essayé d'incorporer ton code au mien, mais cela ne fonctionne pas.

Il ne fait pas l'extraction du document que je veux ouvrir.
De plus, il faut faire une extraction d'une feuille du document que l'on ouvre

bigfish_le vrai · Answer

Montre comment tu l'as integre a ton code

mortalino · Answer

salut,

c'est If Not FileToOpen = vbNullString Then Workbooks.Open FileToOpen 

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA

AiDuK · Answer

Impecable, ca marche magnifiquement :D

Merci à vous deux

AiDuK · Answer

Ah non , il persiste encore un problème.
Actuellement, à partir d'un classeur, il m'en ouvre une autre ( celui que je choisi ) , mais il cherche à faire la copie d'une feuille à une autre de ce classeur que je viens d'ouvrir.

Alors que je souhaites qu'il copie les cellules de la feuille (FIQ) du classeur que je suis allé ouvrir, vers la feuille (BDD) du classeur qui était actuellement en cours d'utilisation.

Sub Extraction()
 
   Dim ProchaineLigneVide As Integer
   Dim FileToOpen As String
   
   FileToOpen = Application.GetOpenFilename("Tout les fichiers Excel (*.xl*;*.xls;*.xla;*.xml;*.xlm;*.xlc;*.xlw),")
    'si l'utilisateur clique sur le bouton Cancel FileToOpen sera = a false
    'donc si FileToOpen n'est pas = a false on ouvre le fichier
   If Not FileToOpen = vbNullString Then Workbooks.Open FileToOpen
           
   marecherche = Sheets("FIQ").Range("Y2").Value
   With Sheets("BDD").Range("a:a")
         Set c = .find(marecherche, LookIn:=xlValues)
     If c Is Nothing Then
     
    With Sheets("BDD")
    ProchaineLigneVide = .Range("A65536").End(xlUp).Row + 1
    .Range("A" & ProchaineLigneVide).Value = Sheets("FIQ").Range("Y2").Value
    .Range("B" & ProchaineLigneVide).Value = Sheets("FIQ").Range("B8").Value
    .Range("C" & ProchaineLigneVide).Value = Sheets("FIQ").Range("J7").Value
    .Range("D" & ProchaineLigneVide).Value = Sheets("FIQ").Range("O9").Value
    .Range("E" & ProchaineLigneVide).Value = Sheets("FIQ").Range("S11").Value
    .Range("F" & ProchaineLigneVide).Value = Sheets("FIQ").Rang("A13").Value
    .Range("G" & ProchaineLigneVide).Value = Sheets("FIQ").Range"V15").Value
    .Range("H" & ProchaineLigneVide).Value = Sheets("FIQ").Range"T13").Value
    End With
    
     End If
    End With
Exit Sub


End Sub

AiDuK · Answer

C'est parfait , cela marche nikel

Merci Beaucoup

[Excel] Faire une Extraction en choisissant le fichier et la feuille d'ou l'on e

8 réponses

Votre réponse

Discussions similaires