Fusion plusieurs fichiers avec condition

KIM

XLDnaute Accro
Bonjour,
J'ai besoin de votre aide pour modifier une macro.
J'utilise la macro suivante du forum pour fusionner un bon nombre de fichiers de structure identique dans un répertoire.

Option Explicit
Const dossier As String = "D:\BUD_2015\" ' à adapter
Sub compiler_classeurs()
Dim fn$, wb As Workbook
fn = Dir(dossier & "*.xls")
If IsNull(fn) Then Exit Sub
Set wb = ThisWorkbook
Application.ScreenUpdating = False
Do While fn <> ""
With Workbooks.Open(dossier & fn)
With .Sheets("DEP_035")
.[B2].Resize(.[B65536].End(xlUp).Row - 1, 184).Copy
wb.Sheets("RECAP").[A65536].End(xlUp)(2).PasteSpecial xlValues
End With
Application.CutCopyMode = False
.Close False
End With
fn = Dir
Loop
End Sub

Je souhaite intégrer la condition suivante :
Recopier de chaque fichier toutes les lignes dont la cellule de la colonne B commence par DP et de longueur 4 (càd DPxx).

Merci de votre aide
KIM
 

Pièces jointes

  • ImportFichiers.xlsm
    12.9 KB · Affichages: 19
  • ImportFichiers.xlsm
    12.9 KB · Affichages: 23
  • ImportFichiers.xlsm
    12.9 KB · Affichages: 23

KIM

XLDnaute Accro
Re : Fusion plusieurs fichiers avec condition

Bonjour Jam, et le forum,
Je vais regarder la page web indiquée.
Mais si tu as ou quelqu'un une réponse à utiliser en attendant que je regarde d'une manière plus approfondie l'utilisation de l'interface ADO.

Merci d'avance
KIM
 

pierrejean

XLDnaute Barbatruc
Re : Fusion plusieurs fichiers avec condition

Bonjour KIM

heureux de te rencontrer à nouveau

Pour ma part ,je pense que la suppression des lignes importées ne correspondant pas au critère est aussi simple

A tester:

Code:
Sub suppression()
Dim n As Integer
Application.ScreenUpdating = False
For n = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
  If Len(Range("A" & n)) <> 4 Or Left(Range("A" & n), 2) <> "DP" Then
    Rows(n).Delete
  End If
Next
Application.ScreenUpdating = True
End Sub
 

KIM

XLDnaute Accro
Re : Fusion plusieurs fichiers avec condition

Bonjour Pierrejean et le fil,
De même, je sui très heureux de te retrouver actif sur le forum. Ton aide est toujours précieuse.
J'ai testé ta macro sur un des fichiers à impoter, elle fonctionne même avec des cellules fusionnées. Par contre elle ne résout pas mon problème. Je dois compiler (importer) un ensemble de fichiers présents dans un répertoire dans un seul fichier en ne recopiant que les lignes dont la cellule de la colonne B commence par DP et de longueur 4 (càd DPxx).
J'ai intégré ta macro dans le scipt d'import en inversant le test mais malheureusement je n'ai pas réussi à recopier les lignes concernées.
Ci-joint mon fichier de recap (ImportFichiers.xlsm) et un des fichiers à importer B.xls.
Merci d'avance de ton aide
KIM
 

Pièces jointes

  • B.xls
    34 KB · Affichages: 23
  • B.xls
    34 KB · Affichages: 20
  • B.xls
    34 KB · Affichages: 18
  • ImportFichiers.xlsm
    14.9 KB · Affichages: 11
  • ImportFichiers.xlsm
    14.9 KB · Affichages: 20
  • ImportFichiers.xlsm
    14.9 KB · Affichages: 21
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Fusion plusieurs fichiers avec condition

Re

Excuses moi , je n'avais pas bien compris ton problème : je pensais que ta macro d'import fonctionnait et importait toutes les lignes

Teste ceci:

Code:
Option Explicit
Const dossier As String = "D:\BUD_2015\" ' à adapter
Sub compiler_classeurs()
'dossier = ThisWorkbook.Path & "\"
Dim fn$, wb As Workbook
Dim n As Integer
fn = Dir(dossier & "*B.xls")
If IsNull(fn) Then Exit Sub
Set wb = ThisWorkbook
ligne = wb.Sheets("RECAP").Range("A" & Rows.Count).End(xlUp).Row + 1
Application.ScreenUpdating = False
    Do While fn <> ""
        With Workbooks.Open(dossier & fn)
            With .Sheets("DEP_035")
'            .[B2].Resize(.[B65536].End(xlUp).Row - 1, 184).Copy
            For n = Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
                If Len(Range("B" & n)) = 4 And Left(Range("B" & n), 2) = "DP" Then
                Rows(n).Copy
                'wb.Sheets("RECAP").[A65536].End(xlUp)(2).PasteSpecial xlValues
                wb.Sheets("RECAP").Range("A" & ligne).PasteSpecial xlValues
                ligne = ligne + 1
                End If


            Next
            End With
            Application.CutCopyMode = False
            .Close False
        End With
    fn = Dir
    Loop
 Application.ScreenUpdating = True
End Sub
 

KIM

XLDnaute Accro
Re : Fusion plusieurs fichiers avec condition

Bonjour Pierrejean et le fil,
Je te remercie pour toa disponibilité.
J'ai testé ta macro, désolé, rien ne se passe, aucun message d'erreurs, aucune donnée copiée dans RECAP.

Merci d'avance.
KIM
 

KIM

XLDnaute Accro
Re : Fusion plusieurs fichiers avec condition

Re,
Désolé Pierrejean, j'ai déjà modifié cette ligne, modifié le chemin d'accès des fichiers, rajouté "Dim ligne As Integer et rien ne se passe, même pas un message d'erreur.
Est-ce les cellules fusionnées peuvent-elles causées ce problème ? Si oui, comment supprimer dans le script la fusion et recopier les colonnes des données : Col B, F, L et N
Je suis en Excel 2010

Merci d'avance
KIM
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Fusion plusieurs fichiers avec condition

Re

Je ne comprends pas !!

Utilise le fichier joint tel quel en mettant le fichier B.xls dans le même répertoire
Cela devrait fonctionner
Ensuite il te faudra adapter a ton environnement
 

Pièces jointes

  • ImportFichiers (1).xlsm
    17.2 KB · Affichages: 16

KIM

XLDnaute Accro
Re : Fusion plusieurs fichiers avec condition

Merci Pierrejean et le fil,
Je ne l'ai pas mis dans le même répertoire, j'ai modifié la définition de la variable "Dossier" et l'import fonctionne.
Je vais le tester en fin de semaine sur un fichier réél et te tiendrai au courant.

Merci de ton aide. Merci aussi à toutes celles ou ceux qui participent à ce forum.

Bonne journée
KIM
 

Discussions similaires

Réponses
4
Affichages
491

Statistiques des forums

Discussions
311 737
Messages
2 082 036
Membres
101 878
dernier inscrit
1475214