Microsoft 365 boucle macro pour importer des données

Arnaud Legay

XLDnaute Nouveau
Bonjour la communauté,
J'ai besoin de votre aide.
Je suis totalement novice en vba, donc je me documente, je teste, je "bricole", mais ça prends forme....

Je souhaite importer des données (colonne A à D, à partir de la ligne 8) de plusieurs fichiers excel situés dans un dossier.
Ces données sont systématiquement (si l'onglet existe) dans un onglet appelé "BOISSONS".

J'ai réussi à lancer ma macro pour :
- ouvrir une boite de dialogue pour sélectionner mes fichiers,
- que ces fichiers s'ouvrent tous sur mon onglet "BOISSONS",
- que les lignes souhaitées soient copiées,
- que ces lignes copiées soient collées (collage spéciales "valeurs") dans mon nouveau document,
- et qu'une partie de mise en forme se fasse.

Mon soucis est que pour le moment, il y a bien une boucle qui se fait si je sélectionne plus que 1 fichier, mais à chaque fois, le collage des données se fait sur le premier collage, donc écrase le premier, et ainsi de suite, alors que j'aimerai que tout se mette à la suite....

Mon explication est-elle claire ?
Pouvez vous m'aider ?

Un grand merci d'avance.

Si dessous mes lignes de code :

Sub Import_quantités_boissons_semaine()

'Affiche la boîte de dialogue "Ouvrir"
Dim l As Long
Dim ClasseurDoc As Variant
l = 0
ClasseurDoc = Application.GetOpenFilename(MultiSelect:=True)
If IsArray(ClasseurDoc) Then
For l = LBound(ClasseurDoc) To UBound(ClasseurDoc)
Workbooks.Open ClasseurDoc(l)

'Sélectionner l'onglet "BOISSON"
ActiveWorkbook.Worksheets("BOISSONS").Activate
On Error Resume Next

'Dans l'onglet "BOISSONS" sélectionner A8/D8 à A50/D50
Range("A8:D50").Select

'Copier les donneés sélectionnées
Selection.Copy

'Retourner dans le fichier de destination
Windows("Test boissons.xlsm").Activate

'Sélectionner la première ligne vide
With Sheets("Feuil")
DLg = .Range("A65536").End(xlUp).Row
If Not .Cells(DLg, 1) = "" Then DLg = DLg + 1
End With

'Coller les données (contenu uniquement)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Supprimer les lignes vides
With Sheets("Feuil1")
For I = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If .Cells(I, 1) = "" Then
Cells(I, 1).EntireRow.Delete
End If
Next I
End With

'Supprimer lignes contenant Glaces Cubes
For I = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(I, 1).Find("Glaces cubes (2,5kg)") Is Nothing Then Rows(I).Delete
Next I

'Supprimer lignes contenant Glaces Cubes
For I = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(I, 1).Find("TOTAL") Is Nothing Then Rows(I).Delete
Next I

'Continuer la boucle
Next l
Else
Workbooks.Open ClasseurDoc

End If

'Ajuster la colonne A au texte
Columns("A:A").EntireColumn.AutoFit

'Supprimer les colonnes B à C inutiles
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft

'Supprimer les colonnes E à O inutiles
Columns("C:O").Select
Selection.Delete Shift:=xlToLeft

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 189
Messages
2 086 031
Membres
103 101
dernier inscrit
CyberAlex93