VBA - Transfert de données à finaliser par une boucle VBA
Bonjour à tous,
Je n'arrive pas à finaliser ma macro par manque de connaissance. C'est pourquoi, je m'adresse à des experts
La macro suivante me permet d'ouvrir le lien dans la cellule x qui ouvre un classeur Excel et de copier des données dans un onglet spécifique puis de revenir dans le fichier source afin de coller les données dans un onglet spécifique.
Maintenant je souhaite rajouter une boucle en VBA afin d'effectuer cette macro sur une suite de cellule contenant des liens hypertexte dans un fichier source et de copier les données de chaque lien hypertexte dans le fichier source les unes en dessous des autres dans un onglet spécifique du fichier source.
20 liens hypertextes pour 20 classeurs Excel.
Les 20 classeurs Excel ont la même structure Excel, les données à rechercher sont dans le même onglet nommé identiquement avec la même cellule de début de la plage de données (seul le nombre de ligne diffère selon les classeurs) à extraire dans le fichier source.
La difficulté pour moi est de dire en VBA de coller les données les unes en dessous des autres et de faire la boucle sur les 20 liens hypertextes donnant accès aux classeurs Excel.
J'arrive à faire deux fichiers, c'est à dire le fichier source et un autre fichier des 20 classeurs Excel. voici le code en dessous.
Sub ex_forward_data()
Application.DisplayAlerts = False 'etat d'affichage des messages d'alerte d'excel ici désactiver
Sheets("xxx").Select ' selectionne la feuille xxx
ActiveWorkbook.FollowHyperlink Address:=Range("x"), NewWindow:=True 'active le lien dans la cellule x
ThisWorkbook.UpdateLinks = xlUpdateLinksAlways ' active la mise à jour des liens avec les classeurs
Sheets("x").Select ' selectionne la feuille ou les données sont à copier
ActiveSheet.AutoFilterMode = True ' enlève les filtres si présent dans la fichier
Range ("y").Select 'selectionne la cellule de départ
Range(Selection, Selection.End(xlToRight)).Select 'crée la sélection de données niveau colonne
Range(Selection, Selection.End(xlDown)).Select 'crée la sélection de données niveau ligne
Selection.Copy ' copy les données
Windows("x.xlsm").Activate 'active le classeur ou les données doivent être collées
Sheets("x").Select
Range ("y").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False 'collage spécial
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("x.xlsx").Activate 'ative le classeur ou les données ont été copiées
ActiveWindow.Close 'close ce classeur
Application.DisplayAlerts = True 'etat d'affichage des messages d'alerte d'excel ici activer
End Sub
Pouvez vous m'aider à finaliser cette macro qui me ferai gagner énormément de temps car je dois faire cette manipulation plusieurs fois par semaine.
Et cette macro marche t elle si un classeur Excel est déjà ouvert?
Merci énorme à ceux qui m'aideront à résoudre cette macro d'opitmisation de données.
bonne journée
Question es ce que tes 20 liens hypertextes sont dans 20 cases différentes dans une seule colonne?
Si c est le cas pourquoi ne pas utiliser une boucle for en en sélectionné tes 20 cellules avant:
il va récupérer le lien hypertexte dans ta cellule, faire ton code, puis passez à la cellule suivante, récupérer le lien.....etc
Dim vcellule As Object
Range("A1:A20").Select
For Each vcellule In Selection
'Ton code
Next
Sinon aucune idée si cela marche ou non lorsque ton classeur est déjà ouvert...
Hello,
Oui je n'y avais pas penser...je me cassais la tête sur le boucle while for....Bref nickel merci.
Par contre, j'ai toujours le soucis pour la boucle d'effectuer l'opération de trouver la dernière ligne et copier à la suite.
En faites, pour le premier lien, la macro devrait me copier les données à partir de la cellule A10 (exemple) puis pour l'ouverture des autres liens me trouver la dernière ligne puis coller à la suite.
As tu une idée?
Merci.
Si j'ai bien compris tu copie tes valeurs sur une ligne,
puis tu recommence avec le fichier suivant mais sur la ligne d'en dessous (Logique) ??
Je peux te proposer sa:
Dim vder As String
Sub test()
vder = Range("A10000").End(xlUp).Address 'récup adresse dernière cellule non vide partant du bas(A10000) en remontant
Range(vder).Select 'selectionne ta cellule
End Sub
Hello,
C'est tout con....merci beaucoup. Ca fonctionne ^^.
Je te souhaite une bonne journée et continuation.