.Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
Sub ExtraireNomsEtValeurs()
Dim targetSheet As Worksheet
Set targetSheet =...
Sub ExtraireNomsEtValeurs()
Dim ws As Worksheet
Dim lastRow As Long
Dim targetSheet As Worksheet
' Feuille où vous souhaitez afficher les résultats
Set targetSheet = ThisWorkbook.Sheets("Synthese") ' Remplacez par le nom de votre feuille
' Démarrer à la ligne 2 (ajuster si nécessaire)
lastRow = 2
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> targetSheet.Name Then ' Ignorer la feuille des résultats
targetSheet.Cells(lastRow, 1).Value = "Feuille " & ws.Name & " - " & ws.Range("H1").Value
targetSheet.Cells(lastRow, 3).Value = ws.Range("B2").Value ' Item 1 à 15
targetSheet.Cells(lastRow, 4).Value = ws.Range("B3").Value
targetSheet.Cells(lastRow, 5).Value = ws.Range("B4").Value
targetSheet.Cells(lastRow, 6).Value = ws.Range("B5").Value
targetSheet.Cells(lastRow, 7).Value = ws.Range("D2").Value
targetSheet.Cells(lastRow, 8).Value = ws.Range("D3").Value
targetSheet.Cells(lastRow, 9).Value = ws.Range("D4").Value
targetSheet.Cells(lastRow, 10).Value = ws.Range("D5").Value
targetSheet.Cells(lastRow, 11).Value = ws.Range("J3").Value
targetSheet.Cells(lastRow, 12).Value = ws.Range("L3").Value
targetSheet.Cells(lastRow, 13).Value = ws.Range("L5").Value
targetSheet.Cells(lastRow, 14).Value = ws.Range("O2").Value
targetSheet.Cells(lastRow, 15).Value = ws.Range("O3").Value
targetSheet.Cells(lastRow, 16).Value = ws.Range("O4").Value
targetSheet.Cells(lastRow, 17).Value = ws.Range("O5").Value
targetSheet.Cells(lastRow, 18).Value = ws.Range("E3").Value ' Intitulé rapide
targetSheet.Cells(lastRow, 19).Value = ws.Range("E5").Value 'Commentaire
lastRow = lastRow + 1
End If
Next ws
End Sub
.Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
Sub ExtraireNomsEtValeurs()
Dim targetSheet As Worksheet
Set targetSheet = ThisWorkbook.Sheets("Synthese")
Dim lastRow As Long
lastRow = 3 ' A adapter en fonction de la première ligne de départ.
Dim ws As Worksheet
With targetSheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Data" And _
ws.Name <> targetSheet.Name Then ' Ignorer la feuille des résultats
.Cells(lastRow, 1).Value = ws.Name & " ---> [Dos N° " & ws.Range("H1").Value & "]"
.Cells(lastRow, 2).Value = ws.Range("B2").Value ' Item 1
.Cells(lastRow, 3).Value = ws.Range("B3").Value ' Item 2
.Cells(lastRow, 4).Value = ws.Range("B4").Value ' Item 3
.Cells(lastRow, 5).Value = ws.Range("B5").Value ' Item 4
.Cells(lastRow, 6).Value = ws.Range("D2").Value ' Item 5
.Cells(lastRow, 7).Value = ws.Range("D3").Value ' Item 6
.Cells(lastRow, 8).Value = ws.Range("D4").Value ' Item 7
.Cells(lastRow, 9).Value = ws.Range("D5").Value ' Item 8
.Cells(lastRow, 10).Value = ws.Range("J3").Value ' Item 9
.Cells(lastRow, 11).Value = ws.Range("L3").Value ' Item 10
.Cells(lastRow, 12).Value = ws.Range("L5").Value ' Item 11
.Cells(lastRow, 13).Value = ws.Range("O2").Value ' Item 12
.Cells(lastRow, 14).Value = ws.Range("O3").Value ' Item 13
.Cells(lastRow, 15).Value = ws.Range("O4").Value ' Item 14
.Cells(lastRow, 16).Value = ws.Range("O5").Value ' Item 15
.Cells(lastRow, 17).Value = ws.Range("E3").Value ' Intitulé rapide
.Cells(lastRow, 18).Value = ws.Range("E5").Value ' Commentaire
' Creation des liens
.Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
lastRow = lastRow + 1
End If
Next ws
End With
End Sub
Sub DupliquerOnglets()
Dim i As Integer
Dim nomFeuille As String
Application.ScreenUpdating = False
' Boucle pour créer les 99 feuilles identiques a la Feuilles 01
For i = 2 To 99
' Copie de la première feuille
Worksheets("01").Copy After:=Sheets(Sheets.Count)
' Nommage de la nouvelle feuille avec un format à 2 chiffres (ex : "02", "03", etc.)
nomFeuille = Format(i, "00")
ActiveSheet.Name = nomFeuille
Worksheets(nomFeuille).Cells(1, 8) = i
Next i
Application.ScreenUpdating = True
End Sub
pour renforcer le tableau de synthese, j'ai souhaiter créer un TCD en onglet 1
aussi, je remarque qu'il compil les infos en provenance de la feuille nommer TCD
dans la macro, j'ai bien vu l'emplacement pour ignorer les feuilles
mais je ne sais pas comment le saisir
Sub ExtraireNomsEtValeurs()
Dim targetSheet As Worksheet
Set targetSheet = ThisWorkbook.Sheets("Synthese")
Dim lastRow As Long
lastRow = 3 ' A adapter en fonction de la première ligne de départ.
Dim ws As Worksheet
' Ajout : j'ai bien vu l'emplacement pour ignorer les feuilles mais je ne sais pas comment le saisir
Dim FeuillesIgnorées As Variant
Dim FeuilleTrouvée As Boolean
Dim i As Integer
' Liste des feuilles à ignorer
FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD")
' Tu peux ajouter d'autres noms ici exemple :
' FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD","Feuil5","Feuil9")
With targetSheet
For Each ws In ThisWorkbook.Worksheets
FeuilleTrouvée = False
' Vérifie si la feuille est dans la liste des feuilles à ignorer
For i = LBound(FeuillesIgnorées) To UBound(FeuillesIgnorées)
If ws.Name = FeuillesIgnorées(i) Then
FeuilleTrouvée = True
Exit For
End If
Next i
' Si la feuille n'est pas à ignorer, traiter les données
If Not FeuilleTrouvée Then
.Cells(lastRow, 1).Value = ws.Name & " ---> [Dos N° " & ws.Range("H1").Value & "]"
.Cells(lastRow, 2).Value = ws.Range("B2").Value ' ***
.Cells(lastRow, 3).Value = ws.Range("B3").Value ' ***
.Cells(lastRow, 4).Value = ws.Range("B4").Value ' ***
.Cells(lastRow, 5).Value = ws.Range("B5").Value ' ***
.Cells(lastRow, 6).Value = ws.Range("D2").Value ' ***
.Cells(lastRow, 7).Value = ws.Range("D3").Value ' ***
.Cells(lastRow, 8).Value = ws.Range("D4").Value ' ***
.Cells(lastRow, 9).Value = ws.Range("D5").Value ' ***
.Cells(lastRow, 10).Value = ws.Range("J3").Value ' ***
.Cells(lastRow, 11).Value = ws.Range("L3").Value ' ***
.Cells(lastRow, 12).Value = ws.Range("L5").Value ' ***
.Cells(lastRow, 13).Value = ws.Range("J5").Value ' ***
.Cells(lastRow, 14).Value = ws.Range("O2").Value ' ***
.Cells(lastRow, 15).Value = ws.Range("O3").Value ' ***
.Cells(lastRow, 16).Value = ws.Range("O4").Value ' ***
.Cells(lastRow, 17).Value = ws.Range("O5").Value ' ***
.Cells(lastRow, 18).Value = ws.Range("N6").Value ' ***
.Cells(lastRow, 20).Value = ws.Range("E3").Value ' Intitulé rapide
.Cells(lastRow, 21).Value = ws.Range("E5").Value ' Commentaire
' Création des liens
.Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
lastRow = lastRow + 1
End If
Next ws
End With
End Sub
aussi, j'ai ce popup
que signifie t'il ?
peux on lui dire de ne pas se réveiller ? ( le popup )