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 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
|
Sub Creer_Recapitulatif()
Dim wbRecap As Workbook 'fichier recap
Dim wsRecap As Worksheet 'feuille où on écrit les données
Dim wbSource As Workbook 'fichier à ouvrir
Dim wssource As Worksheet 'feuille où on cherche les données
Dim DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim i As Integer, k As Integer
Dim rgrecap As Range 'plage où on copie les données
Set wbRecap = ThisWorkbook 'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets(1) 'on écrit dans la feuille 1 du fichier Récap
' Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
' Appel de Fonction pour ouvrir fichiers
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler")
'Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next
Application.ScreenUpdating = False
' Boucle à travers les fichiers
i = UBound(vFichiers)
For k = 1 To i
Application.StatusBar = ">> Lecture du fichier #" & k & "/" & i
Set wbSource = Workbooks.Open(vFichiers(k)) 'Ouvre le fichier
Set wssource = wbSource.Sheets("rapport") 'Copier données de la feuille 1
' ligne pour écrire le log des fichiers compilés
DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 1
'copier les données vers le fichier Recapitulatif; à adapter
Set rgrecap = wsRecap.Range("A65000").End(xlUp).Offset(3, 0)
rgrecap = Time
' MAINTENANT C'EST LE PROGRAMME DE COPIE QUE JE VEUX APPELER àPARTIR D'UN AUTRE MOdULE MAIS çA FONTIONNE PAS
With wssource
rgrecap.Offset(0, 1) = .Range("A14")
rgrecap.Offset(0, 4) = .Range("G59")
rgrecap.Offset(0, 5) = .Range("G70")
rgrecap.Offset(0, 6) = .Range("G74")
rgrecap.Offset(0, 7) = .Range("G78")
rgrecap.Offset(0, 8) = .Range("G82")
End With
'FIN MACRO DE COPIE
wbSource.Close 'fermer fichier
Set wbSource = Nothing ' détruire le fichier
Next k
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub |
Partager