Optimisation Code VBA (parcours page + recup info)
Résolu/Fermé
jpub
Messages postés
43
Date d'inscription
mardi 10 mai 2011
Statut
Membre
Dernière intervention
19 janvier 2016
-
Modifié par jordane45 le 11/12/2014 à 11:12
jpub Messages postés 43 Date d'inscription mardi 10 mai 2011 Statut Membre Dernière intervention 19 janvier 2016 - 12 déc. 2014 à 09:54
jpub Messages postés 43 Date d'inscription mardi 10 mai 2011 Statut Membre Dernière intervention 19 janvier 2016 - 12 déc. 2014 à 09:54
A voir également:
- Optimisation Code VBA (parcours page + recup info)
- Supprimer une page word - Guide
- Consultez le code source de cette page. copiez la ligne indiquant aux moteurs de recherche de ne pas référencer la page. ✓ - Forum Référencement
- Traduire une page web - Guide
- Créer une page facebook - Guide
- Code asci - Guide
3 réponses
jordane45
Messages postés
37253
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 mars 2023
4 551
Modifié par jordane45 le 10/12/2014 à 18:33
Modifié par jordane45 le 10/12/2014 à 18:33
Bonjour,
Visiblement.. tu fais autant de boucles sur tes feuilles.. que tu as de cellules à récupérer...
De plus.. tu utilises le COPY/PAST .. qui bouffe pas mal de ressources...
Si ton but est juste de "copier" les valeurs, il vaut mieux passer par la méthode "VALUE" des cellules.
Et donc.. si j'ai bien compris ton code.. tu souhaites copier, dans la feuille sur laquelle tu te trouves.. les valeurs présentes dans chaque autre onglet...
Peut être quelque chose du genre :
Avant de poser une question, merci de lire la charte du site.
Cordialement, Jordane
Visiblement.. tu fais autant de boucles sur tes feuilles.. que tu as de cellules à récupérer...
De plus.. tu utilises le COPY/PAST .. qui bouffe pas mal de ressources...
Si ton but est juste de "copier" les valeurs, il vaut mieux passer par la méthode "VALUE" des cellules.
Et donc.. si j'ai bien compris ton code.. tu souhaites copier, dans la feuille sur laquelle tu te trouves.. les valeurs présentes dans chaque autre onglet...
Peut être quelque chose du genre :
Sub Snamelist()
Dim LastR As Long
For i = 4 To Sheets.Count
LastR = Derniere_Ligne(ActiveSheet) + 1
Range("B" & LastR).Value = Sheets(i).Range("N2").Value
Range("C" & LastR).Value = Sheets(i).Range("O10").Value
Range("d" & LastR).Value = Sheets(i).Range("z5").Value
Range("e" & LastR).Value = Sheets(i).Range("z6").Value
Next 'Feuille Suivante
End Sub
Function Derniere_Ligne(Sh As Worksheet) As Long
Derniere_Ligne = Sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
End Function
Avant de poser une question, merci de lire la charte du site.
Cordialement, Jordane
jpub
Messages postés
43
Date d'inscription
mardi 10 mai 2011
Statut
Membre
Dernière intervention
19 janvier 2016
1
Modifié par pijaku le 11/12/2014 à 12:03
Modifié par pijaku le 11/12/2014 à 12:03
Bonjour
Et merci de ton aide.
J'ai cependant un petit problème, si je lance plusieurs fois la macro de suite, les mm infos se retrouvent dans le même tableau les une en dessous des autres, que me conseilles-tu :
- dois-je effacer le tableau à l'ouverture du fichier et lancer la macro (+ un un bouton de refresh qui ferait la mm chose) ?
- ou dois-je faire en sorte de sauter les entrées déjà existante et de ne lire que celle qui n'existe pas ? (auquel cas je ne sais pas du tout comment faire ? )
De plus je voudrais faire un lien vers chaque page j'ai donc rajouter une ligne mais bien sur ça ne marche pas
Merci
Et merci de ton aide.
J'ai cependant un petit problème, si je lance plusieurs fois la macro de suite, les mm infos se retrouvent dans le même tableau les une en dessous des autres, que me conseilles-tu :
- dois-je effacer le tableau à l'ouverture du fichier et lancer la macro (+ un un bouton de refresh qui ferait la mm chose) ?
- ou dois-je faire en sorte de sauter les entrées déjà existante et de ne lire que celle qui n'existe pas ? (auquel cas je ne sais pas du tout comment faire ? )
De plus je voudrais faire un lien vers chaque page j'ai donc rajouter une ligne mais bien sur ça ne marche pas
Sub Snamelist()
Dim LastR As Long
For i = 4 To Sheets.Count
LastR = Derniere_Ligne(ActiveSheet) + 1
Range("B" & LastR).Hyperlinks.Add Anchor = Sheets(i).Range("N2"), Address:="", SubAddress:="", TextToDisplay:=""
Range("C" & LastR).Value = Sheets(i).Range("O10").Value
Range("d" & LastR).Value = Sheets(i).Range("z5").Value
Range("e" & LastR).Value = Sheets(i).Range("z6").Value
Next 'Feuille Suivante
End Sub
Function Derniere_Ligne(Sh As Worksheet) As Long
Derniere_Ligne = Sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
End Function
Merci
jordane45
Messages postés
37253
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 mars 2023
4 551
11 déc. 2014 à 10:52
11 déc. 2014 à 10:52
Bonjour,
Perso.. je prendrai le choix 1
Perso.. je prendrai le choix 1
- dois-je effacer le tableau à l'ouverture du fichier et lancer la macro (+ un un bouton de refresh qui ferait la mm chose) ?
jpub
Messages postés
43
Date d'inscription
mardi 10 mai 2011
Statut
Membre
Dernière intervention
19 janvier 2016
1
Modifié par jordane45 le 11/12/2014 à 11:12
Modifié par jordane45 le 11/12/2014 à 11:12
Bonjour,
Merci de ton aide et de ton conseil,
je mettrais le code final dès que possible.
J'ai une dernière question :
Comment faire pour rajouter un lien vers les pages, j'ai essaué le code suivant mais ça ne marche pas, peut être aurais-tu la solution
Merci de ton aide et de ton conseil,
je mettrais le code final dès que possible.
J'ai une dernière question :
Comment faire pour rajouter un lien vers les pages, j'ai essaué le code suivant mais ça ne marche pas, peut être aurais-tu la solution
Sub Snamelist()
Dim LastR As Long
For I = 4 To Sheets.Count
LastR = Derniere_Ligne(ActiveSheet) + 1
Range("B" & LastR).Hyperlinks.Add Anchor = Sheets(I).Range("N2").Value, Address:="", TextToDisplay:=Valeur
Range("C" & LastR).Value = Sheets(I).Range("O10").Value
Range("d" & LastR).Value = Sheets(I).Range("z5").Value
Range("e" & LastR).Value = Sheets(I).Range("z6").Value
Next 'Feuille Suivante
End Sub
Function Derniere_Ligne(Sh As Worksheet) As Long
Derniere_Ligne = Sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
End Function
jordane45
Messages postés
37253
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 mars 2023
4 551
>
jpub
Messages postés
43
Date d'inscription
mardi 10 mai 2011
Statut
Membre
Dernière intervention
19 janvier 2016
11 déc. 2014 à 11:22
11 déc. 2014 à 11:22
Essayes ça :
Sub Snamelist()
Dim LastR As Long
Dim subAss As String
Dim valCell As String
For I = 4 To Sheets.Count
subAdd = Sheets(I).Name & "!N2"
valCell = Sheets(I).Range("N2").Value
LastR = Derniere_Ligne(ActiveSheet) + 1
ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & LastR), Address:="", SubAddress:= _
subAdd, TextToDisplay:=valCell
Range("C" & LastR).Value = Sheets(I).Range("O10").Value
Range("d" & LastR).Value = Sheets(I).Range("z5").Value
Range("e" & LastR).Value = Sheets(I).Range("z6").Value
Next 'Feuille Suivante
End Sub
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
11 déc. 2014 à 12:03
11 déc. 2014 à 12:03
Bonjour,
Lorsque vous placez du code sur notre forum, merci d'utiliser les balises code à votre disposition.
Le mode d'emploi (au cas ou) est ICI.
Cordialement,
Pijaku
Lorsque vous placez du code sur notre forum, merci d'utiliser les balises code à votre disposition.
Le mode d'emploi (au cas ou) est ICI.
Cordialement,
Pijaku
jpub
Messages postés
43
Date d'inscription
mardi 10 mai 2011
Statut
Membre
Dernière intervention
19 janvier 2016
1
11 déc. 2014 à 12:10
11 déc. 2014 à 12:10
Bonjour,
Merci pour l'info, je ferais plus attention,
mais quel code pour VB VBA ?
Merci pour l'info, je ferais plus attention,
mais quel code pour VB VBA ?
jpub
Messages postés
43
Date d'inscription
mardi 10 mai 2011
Statut
Membre
Dernière intervention
19 janvier 2016
1
12 déc. 2014 à 09:54
12 déc. 2014 à 09:54
Bonjour,
Voici donc le code final.
Merci à tous
Voici donc le code final.
Merci à tous
Sub Snamelist()
With Sheets("DASHBOARD").ListObjects("Devoirs")
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With 'Vide le tableau
Sheets("DASHBOARD").Select
Dim LastR As Long
Dim subAss As String
Dim valCell As String
For I = 4 To Sheets.Count
subAdd = Sheets(I).Name & "!N2"
valCell = Sheets(I).Range("N2").Value
LastR = Derniere_Ligne(ActiveSheet) + 1
ActiveSheet.Hyperlinks.Add Anchor:=Range("C" & LastR), Address:="", SubAddress:=subAdd, TextToDisplay:=valCell 'nom de page + lien 'récupère les noms des onglets, les listes dans le tableau en leur attribuantvers l'onglet en question
Range("B" & LastR).Value = Sheets(I).Range("AH2").Value 'type 'copie dans la colonne B la valeur contenue en AH2 de chaque pages
Range("D" & LastR).Value = Sheets(I).Range("O10").Value
Range("F" & LastR).Value = Sheets(I).Range("F48").Value
Range("G" & LastR).Value = Sheets(I).Range("Z5").Value
Next 'Feuille Suivante
End Sub
Function Derniere_Ligne(Sh As Worksheet) As Long
Derniere_Ligne = Sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
End Function