XL 2010 VBA Copie plages cellule fichiers sources vers fichier dest

[spike29]

Bonsoir,

Débutant en VBA, je bloque actuellement sur la récupération de données de deux fichiers sources.

J'ai déjà une macro me permettant de sélectionner et ouvrir les deux fichiers souhaités.

Maintenant, ce que je n'arrive pas a faire c'est sélectionner les informations qui m’intéresse dans ces deux fichiers et les copier dans mon fichier de destination.

Détails de mon besoin :

Mon fichier de destination se nomme Analyse, c'est depuis ce fichier à partir de la Feuil"Analyses" que je lance ma macro.

Elle permet de sélectionner et ouvrir les fichiers sources de mon choix, en l’occurrence :

- Source120112020

- Source220112020

Ces deux fichiers voient leurs nom évoluer quotidiennement en fonction de la date. Seule la racine Source1 et Source2 est fixe, la suite change chaque jour.

1 ère difficulté, comment réussir a activer ces classeurs une fois ouvert afin de venir copier la plage de cellule que j'ai besoin.

J'essaye de faire dire la chose suivante à ma macro sans succès => Activer le workbook qui commence par Source1*

Un début de code qui ne marche pas en dessous, le workbook Source1 n'est pas identifier.

For Each wb In Workbooks

If UCase(wb.Name) Like "Source1*" Then wb.Select: Exit For

With ActiveSheet

Dans l'état, ma macro ouvre les fichiers Source1 et Source2.



Précisions quant à mon besoin, une fois mes 3 fichiers ouverts (Analyse, Source1*, Source2*), je souhaite :

1) Venir copier les cellules C7:I200 de la Feuil("Export_22112020") de classeur Source1 vers la Feuil "Variables1" de mon classeur Analyse (en démarrant par la cellule A12)

On note également que la Feuil du classeur Source1 à une partie de son nom variable selon la date, seule la racine "Export_" reste inchangée.

2) Venir copier les cellules des plages suivante => A7:B5000 puis G7:O5000 puis V7:Y5000 du fichier source2 depuis la Feuil "Base_de_données" vers mon classeur Analyse Feuil Variables2.

Ces 3 plages de cellule formeront dans la Feuil Variable2 du classeur Analyses un tableau, elles seront donc copiées successivement à la suite des autres sans laisser de colonnes vides.

3) Fermer les deux classeurs source une fois la copie réalisée.

Merci d'avance pour votre aide

En PJ les 3 fichiers.

Cdt

 

[Robert]

Bonjour Spike, bonjour le forum,

Je t'ai proposé une solution dans un autre forum...

 

[fanfan38]

Bonjour
Salut Robert
Ci joint ma solution
A+ François

 

[job75]

Bonjour spike29, Robert, fanfan38,

Téléchargez les 3 fichiers joints dans le même dossier (le bureau).

La macro affectée au bouton :

Sub Importer()
Dim chemin$, x$, dat$, n As Byte, dest As Range, fichier$
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
Do
    x = InputBox("Date des fichiers recherchés, format jjmmaaaa :", "Recherche", x)
    If x = "" Then Exit Sub
    dat = Format(x, "00/00/0000")
Loop While Not IsDate(dat)
Application.ScreenUpdating = False
For n = 1 To 2
    Set dest = ThisWorkbook.Sheets("Variables" & n).[A11]
    dest.EntireRow.Resize(5000).Clear 'RAZ
    fichier = Dir(chemin & "Source" & n & "_" & x & ".xlsx") 'à adapter éventuellement
    If fichier <> "" Then
        With Workbooks.Open(chemin & fichier).Sheets(1) '1ère feuille
            IIf(n = 1, .[C7:I200], .[A7:B5000,G7:O5000,V7:Y5000]).Copy dest
            .Parent.Close False
        End With
    End If
Next
End Sub

Attention les noms des 2 fichiers sources doivent différer uniquement par 1 ou 2.

A+

 

[job75]

Une macro un peu plus complète dans ce fichier (2) :

Sub Importer()
Dim chemin$, x$, dat$, n As Byte, dest As Range, fichier$, fich$
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
Do
    x = InputBox("Date des fichiers recherchés, format jjmmaaaa :", "Recherche", x)
    If x = "" Then Exit Sub
    dat = Format(x, "00/00/0000")
Loop While Not IsDate(dat)
Application.ScreenUpdating = False
For n = 1 To 2
    Set dest = ThisWorkbook.Sheets("Variables" & n).[A11]
    dest.EntireRow.Resize(5000).Clear 'RAZ
    fichier = chemin & "Source" & n & "_" & x & ".xlsx" 'à adapter éventuellement
    fich = Dir(fichier)
    If fich = "" Then
        MsgBox "'" & fichier & "' introuvable !", 48
    Else
        With Workbooks.Open(chemin & fich).Sheets(1) '1ère feuille
            IIf(n = 1, .[C7:I200], .[A7:B5000,G7:O5000,V7:Y5000]).Copy dest
            .Parent.Close False
        End With
    End If
    With dest.Parent.UsedRange: End With 'actualise les barres de défilement
Next
End Sub

 

[spike29]

Bonjour Spike, bonjour le forum,

Je t'ai proposé une solution dans un autre forum...

Oui Merci à toi je viens de la voir, elle fonctionne parfaitement.

Bonne journée

 

[spike29]

Bonjour à tous et un grand merci pour vos réponses.

Elles fonctionnent toutes parfaitement. Encore merci à tous !

Bonne journée