Aide Macro - Desoin de simplification ...

[kiss_kool]

bonjour,

Je ne suis pas un grand expert en macro mais j'ai réussi tant bien que mal a rapatrier dans un même fichier les donnée d'une multitude de tableaux (tableau tous identique dans leur structure)
voici la ligne de code:

Sheets("Base de Données").Select
Rows("2:1048576").Select
Selection.Delete Shift:=xlUp

' 1er fournisseur

Sheets("Base de Données").Select
Range("A2").Select
Workbooks.Open Filename:= _
"C:\...\[nomfournisseur1].xlsx" _
, UpdateLinks:=0
Sheets("CA").Select
Range("a2:l" & Range("l1048576").End(xlUp).Row).Select
Selection.Copy
Windows("Synthèse").Activate
Selection.Insert Shift:=xlDown
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
Windows("[nomfournisseur1].xlsx").Activate
ActiveWindow.Close SaveChanges:=False
Sheets("Base de Données").Select

' fournisseur suivant

Range("A2").Select
Workbooks.Open Filename:= _
"C:\...\[nomfournisseur2].xlsx" _
, UpdateLinks:=0
Sheets("CA").Select
Range("a2:l" & Range("l1048576").End(xlUp).Row).Select
Selection.Copy
Windows("Synthèse").Activate
Selection.Insert Shift:=xlDown
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.CommandBars("Task Pane").Visible = False
Windows("[nomfournisseur2].xlsx").Activate
ActiveWindow.Close SaveChanges:=False
Sheets("Base de Données").Select

(Et ça continue comme ça jusqu'à dernier fournisseurs (environ 60)...)

Voici donc mon interrogation ... est il possible de simplifier en récupérant automatiquement les données sans ouvrir les classeurs fournisseurs ?
Et si tout les fichier sont dans le même répertoire, est on obligé de définir la procédure et le chemin d'accès pour chaque fournisseur ? ou existe t'il un moyen plus simple ??
Merci pour votre aide 😉

 

[ERIC S]

Re : Aide Macro - Desoin de simplification ...

Bonjour

une boucle est parfois utile 🙂

un bout de code qui peut peut-être t'inspirer, dans cet exemple, tous les fichiers sont dans le sousrépertoire Données
la boucle balaye tout le sous-répertoire

chemin = ThisWorkbook.Path & "\Données\"
nomfichier = ActiveWorkbook.Name
'
Range("A2").Select
Set fs = Application.FileSearch
With fs
    .LookIn = chemin
    .Filename = "*.xls"
    If .Execute > 0 Then
        MsgBox "Il y  a " & .FoundFiles.Count & " Fichiers Bdd"
        For i = 1 To .FoundFiles.Count
            fichierlu = .FoundFiles(i)
            If Right(fichierlu, 3) = "xls" Then
                Workbooks.Open Filename:=fichierlu
'tu mets ton code ici pour la copie
            End If
            
        Next i
    Else
        MsgBox "Aucun fichier n'a été trouvé."
    End If
End With
Range("A1").Select
End Sub

 

[kiss_kool]

Re : Aide Macro - Desoin de simplification ...

Merci beaucoup !! 🙂

Je test et je vous tiens au courant 😉

 

[kiss_kool]

Re : Aide Macro - Desoin de simplification ...

Arggh ... petit détail que j'ai oublié: j'ai Excel 2007 🙁

Apparemment "petit" problème avec filesearch...

 

[ERIC S]

Re : Aide Macro - Desoin de simplification ...

Bonjour

https://www.excel-downloads.com/threads/filesearch-pour-excel-2007.120556/

en faisant Recherche sur le forum, pas testé