Discussion :

[Baptiste4545]

Bonjour tous le monde,

Je suis face à un problème dans mon script de macro (VBA).
Je possède deux classeurs:
- Le premier possède une liste verticale avec:
- Les noms en première colonne
- La date en deuxième colonne
- Une valeur de mesure en troisième colonne

- Le second est sous forme de carte d'identité et donc les noms sont répartis dans le tableur sur plusieurs feuilles. Sous le nom sont située les mesures en tableau

J'aimerai que la macro puisse faire une boucle où elle prend le premier nom de la liste, elle enregistre les valeurs (date et mesure), elle cherche le nom dans le deuxième classeur parmi toute les feuilles et qu'elle puisse entre la date et la valeur mesuré dans la cellule que je veux.

Le script que je vous transmets ci-dessous fonctionne très bien lorsque dans mon deuxième classeur je n'ai qu'une feuille. Seulement lorsque j'ai plusieurs feuilles, j'ai une erreur de recherche.
Est-il possible de pouvoir chercher dans plusieurs feuille ?

Merci d'avance pour votre aide, je vous joint mon script ci-dessous.


Sub Imporation_données()

'''''''''' Nomme les variables

Dim Derligne As Long 'Variable pour le numéro de la dernière ligne
Dim Nom As String 'Variable pour le Nom
Dim varDate As Date 'Variable pour la Date
Dim Mesure As Single 'Variable pour la Mesure

'Active la feuille où les données sont copiées
Workbooks("Trasnfert_données.xlsx").Activate


''''''''''Boucle pour de recherhce et d'importation des valeurs

'Implémente à la variable 'Derligne' la valeur de fin pour la boucle (Feuille 1, derniere cellule)
Derligne = Sheets("Feuil1").Range("A1048576").End(xlUp).Row
'Implémente à la variable 'Ligne' la valeur de départ (ligne où la boucle doit commencer)
Ligne = 2

'Debut de la boucle, jusqu'à ce que ligne équivaut à la dernière ligne de la feuille
Do While Ligne <= Derligne
'Active le classeur où les données sont copiées
Workbooks("Trasnfert_données.xlsx").Activate
'Implémente à la variable 'Nom' la valeur (Feuil1, Cellule[Ligne,colonne])
Nom = Worksheets("Feuil1").Cells(Ligne, 1)
'Implémente à la variable 'varDate' la valeur (Feuil1, Cellule[Ligne,colonne])
varDate = Worksheets("Feuil1").Cells(Ligne, 2)
'Implémente à la variable 'Mesure' la valeur (Feuil1, Cellule[Ligne,colonne])
Mesure = Worksheets("Feuil1").Cells(Ligne, 3)
'Active le classeur où il faut copier les données
Workbooks("BDD_Suivi").Activate

'Recherche la cellule
Cells.Find(What:=Nom, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

'Importation de la Date

'Déplacer la cellule activer (celle de la recherche)
ActiveCell.Offset(3, 1).Select
'Importe la valeur de la date dans la cellule active
ActiveCell = varDate

'Importation de la Mesure

'Déplacer la cellule activer (celle de la recherche)
ActiveCell.Offset(0, 1).Select
'Donner le nombre de décimale à la cellule active
ActiveCell.NumberFormat = "##0.00"
'Importe la valeur de la date dans la cellule active
ActiveCell = Mesure

'Ajoute à la variable 'Ligne' +1 pour descendre d'une ligne dans le tableau
Ligne = Ligne + 1

'Fin de la boucle
Loop


End Sub

[Tête de chat]

Bonjour,

beaucoup de choses à dire sur ton code

1. mets un option explicit en tête de ton module (ligne n'est pas déclarée)
2. trop de commentaires tue les commentaires. Ça finit par compliquer la lecture. Inutile de plagier le code, mais apporter de l'info

"'Importe la valeur de la date dans la cellule active" n'apporte rien à ActiveCell = varDate"
"Loop" plutôt que "Fin de la boucle" (loop est toujours une fin de boucle) mérite une précision sur la boucle (Ligne <= Derligne)

3. Oublie définitivement les select et les références relatives (selection, cells, range, sheets...) au bénéfice d'objets workbook, worksheet etc ou de with et de références explicites (.cell, .range...). Ça provoque des affichages inutiles, c'est toujours un peu risqu, ça t'oblige à créer des varibles pour mémoriser les valeurs entre deux select etc... Aussi par exemple le fait que tu fasses directement le select sur ton find t'empêche de pouvoir tester le résultat et provoque l'erreur que tu as n cas de non trouvé (tu essayes de faire un select sur une place nulle).

Pour en revenir à la recherche dans le classeur, il suffit de la lancer sur chacune des feuilles du classeur (pas testé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Sub Imporation_données()
 
Dim Derligne As Long 'Variable pour le numéro de la dernière ligne
Dim Ligne As Long ' ligne courante
Dim Unefeuille As Worksheet ' pour parcourir les onglets du classeur cible
Dim Cible As Range ' cellule pour le résultat de la recherche
 
With Workbooks("Trasnfert_données.xlsx").Worksheets("Feuil1") 'feuille où les données sont copiées
 
    ''''''''''Boucle pour de recherche et d'importation des valeurs
    Derligne = .Range("A1048576").End(xlUp).Row
    Ligne = 2
    Do While Ligne <= Derligne
 
        ' on balaye les feuilles du classeur suivi à la recherhce du nom
        For Each Unefeuille In Workbooks("BDD_Suivi").Worksheets
 
            'Recherche la cellule : .Cells(Ligne, 1) contient le nom
            Set Cible = Unefeuille.Cells.Find(What:=.Cells(Ligne, 1), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)
 
            If Not Cible Is Nothing Then 'trouvé -> on pose les valeurs
                Cible.Offset(3, 1).Value = .Cells(Ligne, 2) 'Date
                With Cible.Offset(3, 2) ' Mesure
                    .NumberFormat = "##0.00"
                    .Value = .Cells(Ligne, 3)
                End With
            End If ' trouvé
 
        Next Unefeuille
 
        Ligne = Ligne + 1 ' au suivant
    Loop ' jusqu'à ligne > Derligne
End With ' Trasnfert_données.xlsx
 
End Sub

[Baptiste4545]

Merci beaucoup pour ta réponse !

Pour revenir sur les commentaires, je suis novice en codage j'ai donc besoin de beaucoup d'informations pour voir ce que je fais...

Je n'ai pas très bien compris le 3ème point mais je vois que mon code c'est simplifié !


Tu as réussi à résoudre mon problème et le code marche. J'ai cependant modifié le 'With' car il n'affichait aucune valeur.
Cependant, maintenant il ne m'affiche pas un format date pour la date. Comment pourrai-je lui dire de mettre un tel format dans cette cellule car ta boucle 'with' ne semble pas fonctionner.

Actualisation :

Avec un peu de recherche, j'ai réussi !
Lorsque la valeur à copier est dans une boucle 'with', VBA n'arrive pas à la lire, il faut donc la sortie de cette boucle.

Cela me donne donc le code suivant (avec des classeurs test):

Sub Importation_données()

Dim Derligne As Long ' Variable pour le numéro de la dernière ligne
Dim Ligne As Long ' Ligne courante
Dim Unefeuille As Worksheet ' Pour parcourir les feuilles du classeur cible
Dim Cible As Range ' Cellule pour le résultat de la recherche

With Workbooks("Classeur1").Worksheets("Feuil1") 'feuille où les données sont copiées

''''''''''Boucle pour de recherche et d'importation des valeurs
Derligne = .Range("A1048576").End(xlUp).Row
Ligne = 2
Do While Ligne <= Derligne

' on balaye les feuilles du classeur suivi à la recherhce du nom
For Each Unefeuille In Workbooks("Classeur2").Worksheets

'Recherche la cellule : .Cells(Ligne, 1) contient le nom
Set Cible = Unefeuille.Cells.Find(What:=.Cells(Ligne, 1), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

If Not Cible Is Nothing Then 'trouvé -> on pose les valeurs
With Cible.Offset(3, 1) 'Date
.NumberFormat = "dd/mm/yyyy"
End With
Cible.Offset(3, 1).Value = .Cells(Ligne, 2) 'Date
With Cible.Offset(3, 2)
.NumberFormat = "##0.00"
End With
Cible.Offset(3, 2).Value = .Cells(Ligne, 3) 'Mesure
End If ' trouvé

Next Unefeuille

Ligne = Ligne + 1 ' au suivant
Loop ' jusqu'à ligne > Derligne
End With ' Trasnfert_données.xlsx

End Sub

[Tête de chat]

Re,

Ah oui bien vu j'ai zappé les with imbriqués du coup tu as bien géré le problème

With n'est pas une boucle mais une référence un objet : entre with et end with, tout ce qui commence par un point est relatif à cet objet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Workbooks("Trasnfert_données.xlsx").Activate
Worksheets("Feuil1").Cells(10, 1).Select
Msgbox activeCell
 
Workbooks("Trasnfert_données.xlsx").Worksheets("Feuil1").Activate
Msgbox Cells(10, 1).Value
 
Msgbox Workbooks("Classeur1").Worksheets("Feuil1").Cells(10, 1).value
 
With Workbooks("Classeur1").Worksheets("Feuil1") 
    Msgbox  .Cells(10, 1).value
end with
 
Dim MaSheet as WorkSheet
Set MaSheet = Workbooks("Classeur1").Worksheets("Feuil1") 
MsgBox MaSheet.cells(10,1).value

Sont 5 façons (entre autres) de faire la même chose. Je t'ai déjà dit tout le mal que je pensais des deux premières.
La 3ème est la façon "normale" de faire (enfin une des façons on va rester là dessus pour aujourd'hui)
Quand on a plusieurs utilisations du même objet on peut faire un with (4ème façon) ou utiliser une variable objet (5ème). Le with est moins lisible et doit être réservé aux cas simples... pour ne pas se planter en beauté comme je l'ai fait.

Du coup simplifie un peu la fin de ton code, un with pour une seule utilisation n'a plus de sens :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
' Date
Cible.Offset(3, 1).NumberFormat = "dd/mm/yyyy"
Cible.Offset(3, 1).Value = .Cells(Ligne, 2) 
'Mesure
Cible.Offset(3, 2).NumberFormat = "##0.00"
Cible.Offset(3, 2).Value = .Cells(Ligne, 3)

Ça oblige à écrire deux fois Cible.Offset(3, 1) et Cible.Offset(3, 2), pas assez pour que ça valle le coup de chercher factoriser plus...