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 FeuilleEQUIPSection()
Dim fG As Worksheet, fE As Worksheet
Dim vZ As String, vP As String
Dim lZ As Integer, lP As Integer
Dim c As Variant
Dim d As Object, d1 As Object
Windows("classeurtest3.0").Activate 'Rend le fichier GénérateurSV_v2.10 actif
Worksheets("Page d'acceuil").Activate 'Rend la feuille Templet SV active
FichierAF = Range("B11").Value 'Cellule où se trouve l'adresse du fichier AF
Sheets.Add After:=Worksheets(Worksheets.Count) 'ajoute une feuille dans le classeur actif en fin de classeur
ActiveSheet.Name = "Equip" & "Section" 'Nomme la feuille cr?ee Folder GC Originel
Set AF = Workbooks.Open(FichierAF) ' Ouvre Fichier HEM-AF-6300-001.xlsx
Windows("classeurtest3.0").Activate 'Rend le fichier GénérateurSV_v2.10 actif
Worksheets("Page d'acceuil").Activate 'Rend la feuille Templet SV active
FichierAF = Range("B11").Value 'Cellule où se trouve l'adresse du fichier AF
Set AF = Workbooks.Open(FichierAF) ' Ouvre Fichier HEM-AF-6300-001.xlsx
Windows("HEM-AF-6300-001").Activate 'Rend le fichier GénérateurSV_v2.10 actif
Worksheets("General").Activate 'Rend la feuille Templet SV active
vZ = "Zones et équipements": vP = "Pontage"
Set c = ActiveSheet.Cells.Find(vZ): If Not c Is Nothing Then lZ = c.Row
Set c = ActiveSheet.Cells.Find(vP): If Not c Is Nothing Then lP = c.Row
Set d = CreateObject("scripting.Dictionary")
For Each c In ActiveSheet.Range(ActiveSheet.Cells(lZ + 3, 6), ActiveSheet.Cells(lP - 3, 6))
If c.Value <> "" Then d(c.Value) = c.Offset(, 1).Value
Next c
Set d1 = CreateObject("scripting.dictionary")
For Each c In d.keys()
d1("EQUIP\" & c & "\" & c) = d(c)
d1("EQUIP\" & c & "\HOUR") = ""
d1("EQUIP\" & c & "\MINUTE") = ""
d1("EQUIP\" & c & "\SECOND") = ""
Next c
Windows("classeurtest3.0").Activate 'Rend le fichier GénérateurSV_v2.10 actif
Worksheets("EquipSection").Activate 'Rend la feuille Templet SV active
With ActiveSheet
.Rows(5).Copy .Range("5:" & 5 + d1.Count - 1)
.Cells(5, 2).Resize(d1.Count) = Application.Transpose(d1.keys)
.Cells(5, 3).Resize(d1.Count) = Application.Transpose(d1.items)
End With
End Sub |