Fusion de classeur excel

Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

' Récupération du premier fichier dans le répertoire
Chemin = "V:\Stage\bilan_annuel"
strFile = Dir(Chemin & "\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire
Do While strFile <> ""
' Si le classeur n'est pas le classeur de destination
If strFile <> strWB Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & strFile

' Sélectionner le 1er onglet feuille de saisie
ActiveWorkbook.Worksheets(4).Activate

' Copie des données

Workbooks(strWB).Worksheets("Feuil2").Range("A" & lgDerLig) = Worksheets("1_Descriptif réalisé").Range("C4")

Workbooks(strWB).Worksheets("Feuil2").Range("B" & lgDerLig) = Worksheets("3_Personnel").Range("H8")
Workbooks(strWB).Worksheets("Feuil2").Range("C" & lgDerLig) = Worksheets("3_Personnel").Range("H9")
Workbooks(strWB).Worksheets("Feuil2").Range("D" & lgDerLig) = Worksheets("3_Personnel").Range("H10")
Workbooks(strWB).Worksheets("Feuil1").Range("E" & lgDerLig) = Worksheets("3_Personnel").Range("H11")

Workbooks(strWB).Worksheets("Feuil2").Range("G" & lgDerLig) = Worksheets("3_Personnel").Range("H15")
Workbooks(strWB).Worksheets("Feuil2").Range("H" & lgDerLig) = Worksheets("3_Personnel").Range("H16")
Workbooks(strWB).Worksheets("Feuil2").Range("I" & lgDerLig) = Worksheets("3_Personnel").Range("H17")
Workbooks(strWB).Worksheets("Feuil2").Range("J" & lgDerLig) = Worksheets("3_Personnel").Range("H18")

Workbooks(strWB).Worksheets("Feuil1").Range("K" & lgDerLig) = Worksheets("2_Activités").Range("L17")

lgDerLig = lgDerLig + 1

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Cliquez pour agrandir...