XL 2013 Réouvert - Aide - Macro compilation de fichier

Hugo156

XLDnaute Nouveau
Bonjour à tous,

J'ai adapté une macro pour compiler la même feuille de plusieurs fichiers dans un seul fichier global, mais quand je lance celle-ci j'ai une erreur 400 qui s'affiche :(. Tous les fichiers sont dans le même dossier.

Je ne comprends pas pourquoi.

Voici mon code :

VB:
Option Explicit

Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long

  Set WbDest = ActiveWorkbook

  Chemin = "W:\Etudes\SUPERSONIC\Compilation\"
  NomFichier = Dir(Chemin & "*.xls") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire
    
  Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
    Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
    Set WksNewSheet = WbSource.Sheets("positionnement-etude") 'sélectionne la feuille de données à importer positionnement-etude
    WksNewSheet.Activate                        'active cette feuille
    WksNewSheet.Select
    Range("A5:B120").Select    'selection des données que l’on veut importer
    Selection.Copy                              'copie les données sélectionnées
    WbDest.Activate                             'retourne vers le fichier de départ
    I = ActiveSheet.UsedRange.Rows.Count        'compte le nombre de lignes déjà utilisées dans ce fichier
    Cells(I + 1, 1).Select                      'sélection de la cellule où on veut coller les données (la première vide)
    ActiveSheet.Paste                           'colle les données
    Application.CutCopyMode = False             'termine l'opération
    WbSource.Close                              'ferme le fichier source
    'NomFichier = Dir                            'va vers le fichier suivant à importer
  Loop                                          'recommence la boucle avec le fichier suivant
  WbDest.Activate

End Sub

Je vous mets en pièce jointe mon fichier macro et en we transfer le lien vers les fichiers que je voudrais compiler "trop volumineux pour être sur le site :

Ces fichiers sont en .xls mais il y a des macros est-ce pour ça que cela ne va pas ? Je préfère vous mettre les fichiers originaux pour éviter les erreurs.

Dans mon code, je ne compile que compil que les fichiers .xls mais pensez vous qu'il est possible de compiler les fichiers .xlsx dans la même macro en ajoutant :

NomFichier = Dir(Chemin & "*.xls" & "*.xlsx")

Merci à vous et bonne année :) !!!!

Hugo
 

Pièces jointes

  • compil.xlsm
    15.1 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Evidemment lors de mon essai, les valeurs étaient en "dur" 123,456....
Donc d'après ce que je comprends c'est que ça marche mais il colle des formules.
Dans ce cas dans votre code :
VB:
Remplacez :
ActiveSheet.Paste

Par :
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Cela colle les valeurs.
 

Hugo156

XLDnaute Nouveau
Lors de l'ouverture, les données sont bien présentes.

J'ai essayé avec d'autres fichier (sans macro présente), mais j'ai toujours le même problème. La macro se lance bien mais aucune données de collées dans mon fichier d'origine :(

Qu'elle est votre procédure pour le lancement de la macro ?
 

Hugo156

XLDnaute Nouveau
C'est bon en fait je suis un boulet ..... j'avais lancé la macro dans le même répertoire que mes fichiers à compiler donc il relançait ma macro sans cesse en coupant la boucle.

Merci du coup de main. La fonction de vérification de feuille va me resservir :)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonne nouvelle.
Oui, on peut. Il y a plusieurs exemple sur ce site :
 

Hugo156

XLDnaute Nouveau
J'ai réussi à résoudre mon problème merci beaucoup !!

Au final, pas besoin de la non-ouverture du fichier pour le moment.

Je mets le code à dispo

VB:
Option Explicit

Sub Importfiles()
On Error GoTo Fin
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long

  Set WbDest = ActiveWorkbook

  Chemin = "W:\Etudes\......"
  NomFichier = Dir(Chemin & "*.xls*") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire
    
  Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
    Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
    
    If FeuilleExiste = False Then GoTo Nextone  ' Vérifie si la feuille existe
    Set WksNewSheet = WbSource.Sheets("positionnement-etude") 'sélectionne la feuille de données à importer positionnement-etude
    WksNewSheet.Activate                        'active cette feuille
    WksNewSheet.Select
    Range("A5:M120").Select    'selection des données que l’on veut importer
    Selection.Copy                              'copie les données sélectionnées
    WbDest.Activate                             'retourne vers le fichier de départ
    I = ActiveSheet.UsedRange.Rows.Count        'compte le nombre de lignes déjà utilisées dans ce fichier
    Cells(I + 1, 1).Select                      'sélection de la cellule où on veut coller les données (la première vide)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False                           'colle les données
    Application.CutCopyMode = False             'termine l'opération
Nextone:
    WbSource.Close                              'ferme le fichier source
    NomFichier = Dir()                            'va vers le fichier suivant à importer
  Loop                                          'recommece la boucle avec le fichier suivant
  WbDest.Activate
 
Exit Sub
Fin:
MsgBox (Chemin & Chr(13) & Chr(10) & NomFichier)
End Sub
Function FeuilleExiste() As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )
On Error GoTo SiErreur
Dim Feuille As Worksheet
    FeuilleExiste = False
    For Each Feuille In Worksheets
        If Feuille.Name = "positionnement-etude" Then
            FeuilleExiste = True
            Exit Function
        End If
    Next Feuille
Exit Function
SiErreur:
MsgBox "Une erreur s'est produite..."
FeuilleExiste = CVErr(xlErrNA)
End Function

Le sujet est résolu :)
 

Hugo156

XLDnaute Nouveau
Re-Bonjour tout le monde,

Connaîtriez-vous un moyen de stopper l'enregistrement automatique des fichiers par excel ?

Sur 10 fichiers ce n'était pas génant mais là j'en ai 100 et ça devient très galère ^^.

J'ai testé ce bout de code :

wk1.Close SaveChanges:=False ' fermer le classeur et ignorer toutes les modifications qui lui ont été apportées.

On est bien d'accord, que dans mes variables je dois mettre :

Dim WbDest As Workbook, WbSource, wk1 As Workbook

VB:
Option Explicit

Sub Importfiles()
On Error GoTo Fin
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long

  Set WbDest = ActiveWorkbook

  Chemin = "W:\Etudes\......"
  NomFichier = Dir(Chemin & "*.xls*") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire
    
  Do While NomFichier <> ""                     'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
    Set WbSource = Workbooks.Open(Chemin & NomFichier)   'ouvre le fichier actuel à importer
    
    If FeuilleExiste = False Then GoTo Nextone  ' Vérifie si la feuille existe
    Set WksNewSheet = WbSource.Sheets("positionnement-etude") 'sélectionne la feuille de données à importer positionnement-etude
    WksNewSheet.Activate                        'active cette feuille
    WksNewSheet.Select
    Range("A5:M120").Select    'selection des données que l’on veut importer
    Selection.Copy                              'copie les données sélectionnées
    WbDest.Activate                             'retourne vers le fichier de départ
    I = ActiveSheet.UsedRange.Rows.Count        'compte le nombre de lignes déjà utilisées dans ce fichier
    Cells(I + 1, 1).Select                      'sélection de la cellule où on veut coller les données (la première vide)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False                           'colle les données
    Application.CutCopyMode = False             'termine l'opération
Nextone:
    'WbSource.Close                              'ferme le fichier source
    wk1.Close SaveChanges:=False  ' fermer le classeur et ignorer toutes les modifications qui lui ont été apportées.
    NomFichier = Dir()                            'va vers le fichier suivant à importer
  Loop                                          'recommece la boucle avec le fichier suivant
  WbDest.Activate
 
Exit Sub
Fin:
MsgBox (Chemin & Chr(13) & Chr(10) & NomFichier)
End Sub
Function FeuilleExiste() As Boolean
'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
'par Excel-Malin.com ( https://excel-malin.com )
On Error GoTo SiErreur
Dim Feuille As Worksheet
    FeuilleExiste = False
    For Each Feuille In Worksheets
        If Feuille.Name = "positionnement-etude" Then
            FeuilleExiste = True
            Exit Function
        End If
    Next Feuille
Exit Function
SiErreur:
MsgBox "Une erreur s'est produite..."
FeuilleExiste = CVErr(xlErrNA)
End Function

Mon problème est que lorsque je fais ça, ma boucle ce stoppe et il m'affiche directement le nom du chemin et fichier. Comme s'il avait fini son exécution.

Merci pour votre aide :)
 

Discussions similaires

Statistiques des forums

Discussions
311 716
Messages
2 081 848
Membres
101 826
dernier inscrit
dododu89