XL 2013 Fusion exel et plus si affinité...

M

miracle17

XLDnaute Nouveau
Bonjour,

Oui, je sais, à voir "fusion exel" en titre dois déjà en irrité plus d'un car les discutions sur ce sujet ne manque pas.... mais je n'ai pas réussi à trouver mon bonheur, ou du moins à faire fonctionner les bouts de macro que j'ai pu trouver sur le net... J'implore votre clémence ^^

Donc voila,j'ai de très nombreux fichiers exels sous le format du fichierC01 FOCH_20151.
A chaque mois, il change de nom de la manière suivante C01 FOCH_20152, puis C01 FOCH_20153 ....

Je souhaite à minima réussir à compiler ces fichiers en un seul, mais en excluant la ligne A1 (c'est là que j'ai des difficultés...).

Sinon, mon projet, mais il est plus complexe serait de pouvoir compiler les données dans le fichiers "poste vierge". Le problème est que souvent le fichier est bugé et il manque une date ou deux.... Il faudrait pouvoir faire un copier coller par ligne...

Voila, merci à vous par avance.
 

Pièces jointes

  • C01 FOCH_20151.xls
    2.3 KB · Affichages: 27
  • POSTE VIERGE.xlsx
    55.6 KB · Affichages: 36
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Re : Fusion exel et plus si affinité...

Hello

un début de réponse
code à mettre dans un module du fichier PosteVierge
Code: 
Sub importer()

Set OngletVierge = ActiveWorkbook.ActiveSheet

MsgBox ("sélectionnez le fichier data à ouvrir")
NomFile = Application.GetOpenFilename("Fichiers excel (*.xls),*.xls")
Workbooks.Open NomFile

Set ListeDate = Range("A2:A" & Range("A65536").End(xlUp).Row)
ListeDate.Select

For Each jour In ListeDate
    'MsgBox jour
    With OngletVierge
        Set ligne = .Columns("A:A").Find(jour)
        If Not ligne Is Nothing Then
        l = ligne.Row
        Range("A" & jour.Row & ":H" & jour.Row).Copy (.Range("A" & l))
        End If
    End With
    
Next jour
End Sub

à noter: pb de changement de format des dates entre le 01/12/2015 et le 13/01/2015....
 
Vote positif 0 Vote négatif
M

miracle17

XLDnaute Nouveau
Re : Fusion exel et plus si affinité...

Super ! Merci pour ta réponse !

Il y a toutefois un petit bug, il importe bien le fichier,
Il place bien le 01/01/2015, toutefois il va placer le 02/01/2015 sur le 01/02/2015.

Tu as une idée de ce qui provoque ce bug ?
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Fusion exel et plus si affinité...

le bug dont tu parles.. répond à la question
à noter: pb de changement de format des dates entre le 01/12/2015 et le 13/01/2015....
Cliquez pour agrandir...

Problème de format de date:
dans ton fichier C01 FOCH.. il y a du format date Americain (Mois/jour/Année) et du format Européen (Jour /Mois /Année)
Il place bien le 01/01/2015, toutefois il va placer le 02/01/2015 sur le 01/02/2015.
Cliquez pour agrandir...
le 01/01/2015 est lu comme le 01 janvier..
et le 01/02/2015 est lu comme le 01 FEVRIER... et donc. est placé à sa bonne place..


donc..Question: un fichier FOCH = 1 mois et un seul?
Est ce que les dates sont forcément dans l'ordre?

si oui, il faudrait commencer par "forcer" un seul et unique format de date
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Fusion exel et plus si affinité...

vu que ton fichier source contient ET du format US et Européen ET du standard... difficile de faire le tri..
essaie avec ce code

Code: 
Sub importer()

Set OngletVierge = ActiveWorkbook.ActiveSheet

MsgBox ("sélectionnez le fichier data à ouvrir")
'ouvre la boite de dialogue pour sélectionner le fichier à ouvrir
NomFile = Application.GetOpenFilename("Fichiers excel (*.xls),*.xls")
'OUVRE le fichier
Workbooks.Open NomFile


Set listeDate = Range("A2:A" & Range("A65536").End(xlUp).Row)

nbjour = listeDate.Count
Dernier = listeDate.Item(nbjour)
'boucle jusqu'au dernier jour pour inverser jour et mois d'un format date US à Européen si necessaire
For i = 2 To nbjour + 1
    jour = Range("A" & i)
    If Day(jour) = Month(Dernier) Then 'suppose que le dernier jour de la liste est dans le bon format: Jour/Mois/Année
        'on rebascule en format date european
        Range("A" & i) = DateSerial(Year(jour), Day(jour), Month(jour))
    End If
Next i


listeDate.Select
Selection.NumberFormat = "dd/mm/yyyy"
Selection.HorizontalAlignment = xlCenter

'pour chaque jour de la liste, on cherche sa place dans le fichier "PosteVierge" et on recopie les data
For Each jour In listeDate
    'MsgBox jour
    With OngletVierge
        Set ligne = .Columns("A:A").Find(CDate(jour))
        If Not ligne Is Nothing Then
        l = ligne.Row
        Range("A" & jour.Row & ":H" & jour.Row).Copy (.Range("A" & l))
        End If
    End With
    
Next jour
End Sub
 
Vote positif 0 Vote négatif
M

miracle17

XLDnaute Nouveau
Re : Fusion exel et plus si affinité...

Ok ! Je comprends mieux ta remarque. J'ai vérifié mon stock de fichier (124 *12...) et je ne suis en date européenne dans 90% des cas. Il y a parfois quelques erreurs que je n'explique pas.

Toutefois, ton fichier marque à merveille ! Vraiment un grand merci à toi !
Par hasard, il y aurait il un code pour fermer automatiquement le fichier qu'on importe (oui quitte à automatiser :cool:)

Dans tout les cas, je te remercie beaucoup !
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Fusion exel et plus si affinité...

Une autre solution qui te permet d'effectuer le travail sur TOUS les fichiers présents dans un répertoire
ici C:\test\

Code: 
Sub importer()
Dim myPath As String, myFile As Variant
Dim wb As Workbook

Set OngletVierge = ActiveWorkbook.ActiveSheet

'permet de parcourir tous les fichiers d'un meme répertoire sans avoir à les sélectionner un par un
'**************************
Application.ScreenUpdating = True
'répertoire contenant les fichiers à traiter
myPath = "C:\Test\"
'extension des fichiers à traiter
myFile = Dir(myPath & "\*.xls*")

Do While myFile <> "" 'pour chaque fichier du répertoire
    Set wb = Workbooks.Open(myPath & myFile)
    wb.Activate
  

    'MsgBox ("sélectionnez le fichier data à ouvrir")
    ''ouvre la boite de dialogue pour sélectionner le fichier à ouvrir
    'Nomfile = Application.GetOpenFilename("Fichiers excel (*.xls),*.xls")
    ''OUVRE le fichier
    'Workbooks.Open Nomfile


    Set listeDate = Range("A2:A" & Range("A65536").End(xlUp).Row)

    nbjour = listeDate.Count
    Dernier = listeDate.Item(nbjour)
    'boucle jusqu'au dernier jour pour inverser jour et mois d'un format date US à Européen si necessaire
    For i = 2 To nbjour + 1
        jour = Range("A" & i)
        If Day(jour) = Month(Dernier) Then 'suppose que le dernier jour de la liste est dans le bon format: Jour/Mois/Année
            'on rebascule en format date european
            Range("A" & i) = DateSerial(Year(jour), Day(jour), Month(jour))
        End If
    Next i
    
    'on affecte un seul format date à toute la colonne et on centre
    listeDate.Select
    Selection.NumberFormat = "dd/mm/yyyy"
    Selection.HorizontalAlignment = xlCenter

    'pour chaque jour de la liste, on cherche sa place dans le fichier "PosteVierge" et on recopie les data
    For Each jour In listeDate
        'MsgBox jour
        With OngletVierge
            Set ligne = .Columns("A:A").Find(CDate(jour))
            If Not ligne Is Nothing Then
                l = ligne.Row
                Range("A" & jour.Row & ":H" & jour.Row).Copy (.Range("A" & l))
            End If
        End With
    Next jour

    'fermeture du fichier source
    ActiveWindow.Close savechanges:=False

    'libère la variable
    myFile = Dir()
Loop
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : Fusion exel et plus si affinité...

Une variante qui te permet de sélectionner le répertoire souhaité sans avoir à l'écrire en dur dans le code

Code: 
Sub importer()
Dim myPath As String, myFile As Variant
Dim wb As Workbook
Dim Repertoire As FileDialog

Set OngletVierge = ActiveWorkbook.ActiveSheet

'on récupère juste le répertoire de travail en demandant de sélectionner un fichier
'ouvre la boite de dialogue pour sélectionner le répertoire des fichiers à ouvrir
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
 
    myPath = CStr(Repertoire.SelectedItems(1)) & "\"
    'MsgBox myPath

'permet de parcourir tous les fichiers d'un meme répertoire sans avoir à les sélectionner un par un
'**************************
Application.ScreenUpdating = True

'extension des fichiers à traiter
myFile = Dir(myPath & "\*.xls*")

Do While myFile <> "" 'pour chaque fichier du répertoire
    Set wb = Workbooks.Open(myPath & myFile)
    wb.Activate
  

    'MsgBox ("sélectionnez le fichier data à ouvrir")
    ''ouvre la boite de dialogue pour sélectionner le fichier à ouvrir
    'Nomfile = Application.GetOpenFilename("Fichiers excel (*.xls),*.xls")
    ''OUVRE le fichier
    'Workbooks.Open Nomfile


    Set listeDate = Range("A2:A" & Range("A65536").End(xlUp).Row)

    nbjour = listeDate.Count
    Dernier = listeDate.Item(nbjour)
    'boucle jusqu'au dernier jour pour inverser jour et mois d'un format date US à Européen si necessaire
    For i = 2 To nbjour + 1
        jour = Range("A" & i)
        If Day(jour) = Month(Dernier) Then 'suppose que le dernier jour de la liste est dans le bon format: Jour/Mois/Année
            'on rebascule en format date european
            Range("A" & i) = DateSerial(Year(jour), Day(jour), Month(jour))
        End If
    Next i
    
    'on affecte un seul format date à toute la colonne et on centre
    listeDate.Select
    Selection.NumberFormat = "dd/mm/yyyy"
    Selection.HorizontalAlignment = xlCenter

    'pour chaque jour de la liste, on cherche sa place dans le fichier "PosteVierge" et on recopie les data
    For Each jour In listeDate
        'MsgBox jour
        With OngletVierge
            Set ligne = .Columns("A:A").Find(CDate(jour))
            If Not ligne Is Nothing Then
                l = ligne.Row
                Range("A" & jour.Row & ":H" & jour.Row).Copy (.Range("A" & l))
            End If
        End With
    Next jour

    'fermeture du fichier source
    ActiveWindow.Close savechanges:=False

    'libère la variable
    myFile = Dir()
Loop
End Sub
 
Vote positif 0 Vote négatif
M

miracle17

XLDnaute Nouveau
Re : Fusion exel et plus si affinité...

Re !

A l'utilisation, il se trouve que j'ai un petit problème tout les 13 du mois. Il ne me prends pas en compte les données du 13 au 30 ou 31 du mois.

Tu as une idée du problème ? peut être par rapport au problème de format qui était présent dans mon premier fichier ?
 
Vote positif 0 Vote négatif
M

miracle17

XLDnaute Nouveau
Re : Fusion exel et plus si affinité...

Je vais essayer en supprimant cette boucle.

[CODE Dernier = listeDate.Item(nbjour)
'boucle jusqu'au dernier jour pour inverser jour et mois d'un format date US à Européen si necessaire
For i = 2 To nbjour + 1
jour = Range("A" & i)
If Day(jour) = Month(Dernier) Then 'suppose que le dernier jour de la liste est dans le bon format: Jour/Mois/Année
'on rebascule en format date european
Range("A" & i) = DateSerial(Year(jour), Day(jour), Month(jour))
End If
Next i][/CODE][/HTML] nbjour = listeDate.Count
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
XL 2013 Formules exel
Réponses
12
Affichages
623
SéverineP
S
A
  • Résolu(e)
Microsoft 365 Excel 365 x Power Query : suivi campagnes promotionnelles
Réponses
4
Affichages
675
Atsuki
A
E
  • Résolu(e)
Microsoft 365 Conception d'un outils alliant faciliter d'utilisation et optimisation de la RAM/Processeur/Espace Disque
Réponses
6
Affichages
451
elgringo123456
E
king76
  • Question
XL 2016 [RÉSOLU] Comment filtrer les enregistrements unique dans Power Query à partir de deux champs ?
Réponses
6
Affichages
741
king76
king76
S
  • Question
Microsoft 365 recherche les 10 plus grandes valeurs et reporter les noms des lignes et colonne
Réponses
9
Affichages
917
Hasco
Hasco
C
  • Question
XL 2019 recherche v, #valeur et fonction si
Réponses
2
Affichages
889
cocktail
C
R
  • Résolu(e)
Autres Comparer deux classeurs et noter les ajouts dans un troisième (ou sur une nouvelle feuille du second)
Réponses
3
Affichages
713
Laurent81
Laurent81
C
  • Question
Tri avec sort plus rapide ?
Réponses
3
Affichages
961
ccdouble6
C
C
  • Question
Microsoft 365 Affichage qui fluctue et gene la sélection de cellule
Réponses
1
Affichages
775
capc93
C
R
  • Question
RechercheV combiné avec "SI" et "ET"
Réponses
8
Affichages
4 K
Dugenou
Dugenou

Membres actuellement en ligne

7 membres et 62 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 221
Membres
103 158
dernier inscrit
laufin