Copier données d'un autre fichier sans connaitre le nom total+emplacement

Bonjour à tous,

je cherche à réaliser une macro qui viendrait copier une sélection d'un fichier B pour venir la coller dans un fichier A.

• Les deux fichiers sont rangés dans le même dossier. Mais ce dossier ne sera pas forcément toujours le même. L'instruction donnée aux opérateurs pour utiliser cette macro sera "placer les deux fichiers dans le même dossier".
• Je ne connais qu'une partie du nom du fichier B. En effet, le fichier B portera un nom du type Rapport_XXXXX, la seule constante sera donc "rapport".
• Est-on obligé d'ouvrir le ficher B ? VBA n'a-t-il pas la possibilité de copier des données sans ouvrir le fichier

Avez-vous une idée de ce sur quoi je peux partir ?

Merci

Bonjour,

C'est le seul fichier qui contiendrait "Rapport" dans son nom dans le répertoire ?

Oui!

Option Explicit

Sub TestFichierRapport()

Dim NomFichier As String

    NomFichier = FichierRapport(ActiveWorkbook.Path, "Rapport")
    If NomFichier <> "" Then
       Workbooks.Open NomFichier
    End If

End Sub

Function FichierRapport(ByVal RepertoireFichier As String, ByVal NomPartielFichier As String) As String

Dim Fso As Object, FolderEnCours As Object, FichierEnCours As Object

    FichierRapport = ""

    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.FolderExists(RepertoireFichier) Then
       Set FolderEnCours = Fso.GetFolder(RepertoireFichier)
       For Each FichierEnCours In FolderEnCours.Files
           If InStr(1, FichierEnCours.Name, NomPartielFichier, vbTextCompare) > 0 Then
              FichierRapport = FichierEnCours.Name
           End If
       Next FichierEnCours
    End If

   Set FolderEnCours = Nothing: Set Fso = Nothing

End Function

Merci je vais essayer. Mais si je ne me trompe pas, ton code ouvre le fichier ?

J'ai essayé cela :

Sub copiersansouvrir()

    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = .Range("A2", .Range("AO65536").End(xlUp))
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"

    Feuille = "feuill1" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = "\*rapport.xls"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"

    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With

    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic

    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")

    Range("A2").CopyFromRecordset Rst

    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing

End Sub

Mais

 Dim Source As ADODB.Connection

ne fonctionne pas...

Bonjour

Dim Source As ADODB.Connection ne fonctionne pas il faut activer les Microsoft activeX Dataobjects 2.5 librairy

Dans l'editeur VBA , outils -> references

Cdlt

Mais si je ne me trompe pas, ton code ouvre le fichier ?

Dans

Sub TestFichierRapport()

Dim NomFichier As String

    NomFichier = FichierRapport(ActiveWorkbook.Path, "Rapport")
    If NomFichier <> "" Then
       Workbooks.Open NomFichier
    End If

End Sub

Workbooks.Open NomFichier n'est qu'un exemple. Si NomFichier est différent de vide, c'est qu'il a trouvé le nom du fichier.

Je suis parti sur la methode ADODB. J'ai pu rajouter la librairie via les outils.

En revanche j'ai un message d'erreur :

Erreur d'exécution '-2147467259 (80004005)':
Erreur Automation
Erreur non spécifiée

Sub copier()

    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A2:AO20000"
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"

    Feuille = "feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = "C:\rapportB.xlsx"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"

    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With

    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic

    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")

    Range("A2").CopyFromRecordset Rst

    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing

End Sub

Avez-vous une idée ?

Je ne suis pas un spécialiste de cette méthode.

La réponse a été donnée par rapport à la question initiale posée. Vous devriez créer un nouveau message par rapport à votre nouveau problème et solder celui-ci.