Boucle For Each

Bonjour à tous,

Sur la colonne A j'ai une liste de nom A,B,C..., Sur la colonne G une liste de lien url.

La macro suivante crée des raccourcis dans le répertoire GG, en associant le nom du raccourci (colonne A1) avec li lien url correspondant (colonne G1)..

Sub E()
Dim E As String
Dim R As String

For Each Cell In ActiveSheet.Range("A1:A5")
    For Each Cell2 In ActiveSheet.Range("G1:G5")
     R = Cell2.Value
              E = Cell.Value

Set scrHst = CreateObject("WScript.Shell")
emplacement = "C:\Users\Toto\Desktop\gg"
Set raccourci = scrHst.CreateShortcut(emplacement & "\" & E & ".lnk")
raccourci.WorkingDirectory = emplacement
raccourci.TargetPath = R
raccourci.Save
Set raccourci = Nothing
Set scrHst = Nothing

            Next Cell2
                Next Cell

Mon problème la macro crée bien une liste de raccourci en utilisant les nom A1 , A2,A3.. là tout fonctionne bien, mais pour les liens url , elle me colle le lien url ecrit en G5 Sur tous les raccourcis créés .

Merci de votre aide

Greg

Bonjour,

C'est normal, tu crées 2 boucles imbriquées là où une seule suffirait. Actuellement, pour chaque cellule en colonne A, tu parcours toutes les cellules en colonne G. Remplace donc tes 2 boucles par ceci :

Sub E()

Dim E As String, R As String, i As Integer
'Dim emplacement As ???, raccourci As ???, scrHst As ???

emplacement = "C:\Users\Toto\Desktop\gg" 'Inutile dans la boucle, il ne varie pas
For i = 1 To 5
   R = Range("G" & i).Value
   E = Range("A" & i).Value
   Set scrHst = CreateObject("WScript.Shell")
   Set raccourci = scrHst.CreateShortcut(emplacement & "\" & E & ".lnk")
   raccourci.WorkingDirectory = emplacement
   raccourci.TargetPath = R
   raccourci.Save
   Set raccourci = Nothing
   Set scrHst = Nothing
Next i

End Sub

Merci Pedro,

Bonne journée

Greg

greg954 a écrit :

Merci Pedro,

Bonne journée

Greg

Pas de quoi !