1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
| Sub CreationSynthese()
'Effacer la base de données du fichier _Suivi
Range("B3:S1048576").Select
Selection.ClearContents
'Blocage du recalcul automatique pour gagner du temps
Application.Calculation = xlCalculationManual
'Désactiver le rafraîchissement de l'écran pour gagner du temps
Application.ScreenUpdating = False
'Nomme le chemin d'accès, sur le serveur, le classeur où tous les fichiers PPQAI en .xlsx sont conservés
Dim filen As String, filepath As String, myfile As String
filen = "*.xlsx"
filepath = "\\srvdanco\PPQAI\"
myfile = Dir(filepath & filen)
'Avise que tant qu'il y a des noms de fichiers (nb de caractères > que zéro), de les prendre en compte
While Len(myfile) > 0
Workbooks.Open (filepath & myfile)
'Indique comment copier les PPQAI de E5 à V...
AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count - 5
Range("E5:V" & AvantDerniereLigne).Copy
'Ouvre le fichier _Suivi et colle les valeurs de tous les PPQAI un à la suite de l'autre à la position désirée
Workbooks("_Suivi.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 2
Range("B" & DebutNomFichier).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Efface les lignes sans données
For i = [C1048576].End(xlUp).Row To 2 Step -1
If Len(Cells(i, 3)) = "" Or Cells(i, 3) = 0 Then
Rows(i).Delete
Range("B" & DebutNomFichier & ":B" & ActiveSheet.UsedRange.Rows.Count) = myfile
'Renommer correctement la colonne B avec le no du client
Columns("B:B").Replace ".xlsx", ""
Columns("B:B").Replace "PPQAI-", ""
End If
Next
'Désactive la bte de dialogue du presse papier à la fermeture de chaque fichier
Application.CutCopyMode = False
Workbooks(myfile).Close False
'Donne l'ordre d'ouvrir un après l'autre tous les fichiers du classeur et de répéter l'action
myfile = Dir
Wend
'Importation terminée, quelques ajustements finaux au fichier _Suivi
Range("A1").Select
'Remise en route du recalcul automatique
Application.Calculation = xlCalculationAutomatic
'Réactive le rafraîchissement de l'écran pour gagner du temps
Application.ScreenUpdating = True
MsgBox "L'importation des PPQAI est terminé"
End Sub |
Partager