XL 2010 VBA Copie plages cellule fichiers sources vers fichier dest

spike29

XLDnaute Occasionnel
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.

VB:
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
 

Pièces jointes

  • Analyse.xlsm
    24.9 KB · Affichages: 14
  • Source120112020.xlsx
    9.5 KB · Affichages: 4
  • Sources2_20112020.xlsx
    12.1 KB · Affichages: 3
Solution
Une macro un peu plus complète dans ce fichier (2) :
VB:
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 &...

job75

XLDnaute Barbatruc
Bonjour spike29, Robert, fanfan38,

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

La macro affectée au bouton :
VB:
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+
 

Pièces jointes

  • Analyse(1).xlsm
    21 KB · Affichages: 6
  • Source1_20112020.xlsx
    9.5 KB · Affichages: 5
  • Source2_20112020.xlsx
    12.7 KB · Affichages: 5

job75

XLDnaute Barbatruc
Une macro un peu plus complète dans ce fichier (2) :
VB:
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
 

Pièces jointes

  • Analyse(2).xlsm
    21.4 KB · Affichages: 10

Discussions similaires

Réponses
5
Affichages
335
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll