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
|
Sub Restitution()
'Zone de déclaration des variables
Dim Chemin1 As String, Chemin2 As String 'Chemin du fichier en entier
Dim Classeur1 As String, Classeur2 As String 'Classeur Source
Dim FeuilleD As String 'Feuille Destination
Dim FD As Worksheet, FS As Worksheet 'Feuille Actuel (en général "Feuil1")
Dim NBligne As Long, NBcolonne As Long, i As Long, j As Long, compteur As Long
Dim WB As Workbook
Dim NomClasseur As String, NBclasseur As Long
'Zone d'initialisation
FeuilleD = "Feuil1"
Chemin1 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1110_Fichier_assures_gestion_des_droits_de_base.xls"
Classeur1 = "1110_Fichier_assures_gestion_des_droits_de_base.xls"
Chemin2 = "C:\Documents and Settings\FRONTIERE-02766\Bureau\doc flo\SAP_DASHBOARD\docs CPAM\POLARIS Commentaire\1140_CMU_de_base.xls"
Classeur2 = "1140_CMU_de_base.xls"
NBclasseur = 2
'Début de la macro
Set WD = Workbooks("Restitution_historique.xls")
Set FD = Workbooks("Restitution_historique.xls").Worksheets(FeuilleD)
Workbooks.Open (Chemin1)
Workbooks.Open (Chemin2)
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
ActiveWindow.Visible = False
End If
NomClasseurD = WD.Name
compteur = 1
For Each WB In Workbooks
NomClasseur = WB.Name
If NomClasseur <> NomClasseurD Then
Set FS = Worksheets("Commentaire")
With FS
NBligne = .Cells(.Rows.Count, 3).End(xlUp).Row
NBcolonne = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With
For i = 3 To NBligne
compteur = compteur + 1
FD.Cells(compteur, 1).Value = FS.Cells(2, 1).Value
FD.Cells(compteur, 2).Value = FS.Cells(2, 2).Value
FD.Cells(compteur, 3).Value = FS.Cells(i, 3).Value
FD.Cells(compteur, 4).Value = FS.Cells(i, 4).Value
Next
WB.close
End If
Next
Workbooks(Classeur1).Close False
Workbooks(Classeur2).Close False
End Sub |
Partager