VBA récupération de données selon les feuilles

boulbes7

XLDnaute Nouveau
Bonjour à tous,

J'aimerai savoir si quelqu'un à déjà essayé créer une macro récupération de donnée qui en fonction des numéros inscrit dans mon cas dans la colonne B aille directement voir la feuille (nommer avec le même numéro )concernée et copier les données dans ma feuille budget. Ma macro marche dans le cas d'une cellule par contre j'aimerai l'élargir à la colonne B ( afin que la macro teste cellule de B8 à B200 et dés que cellule B9=2 alors aller à feuille 2 et recopier certaines données dans BUDGET.
Ci joint le fichier pour ce qui voudrons bien m'aider.
Merci pour votre aide...
 

Pièces jointes

  • Sous détails .xls
    200.5 KB · Affichages: 62

Robert

XLDnaute Barbatruc
Repose en paix
Re : VBA récupération de données selon les feuilles

Bonjour Boulbes, bonjour le forum,

Tu vois, j'avais raison... Future solution...
J'ai pas vraiment compris où tu voulais en venir avec ton code mais je te propose le code ci-dessous. En fonction de la valeur de la cellule dans la colonne B l'onglet o va être définit :
Code:
Sub copidon()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim o As Object 'déclare la variable o (Onglet)
Dim b As Object 'déclare la variable b (onglet Budget)
Dim cel As Range 'déclare la variable cel (CELlule)

Set b = Sheets("BUDGET") 'définit l'onglet b ("BUDGET")
With b 'prend en compte l'onglet "BUDGET"
    dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée de la colonne B
    Set pl = .Range("B8:B" & dl) 'définit la plage pl
End With 'fin de la prose en compte de l'onglet "BUDGET"
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Value <> "" Then 'condition 1 : si la cellule n'est pas vide
        On Error Resume Next 'gestion des erreurs (si une erreur est générée, passe à la ligne suivante)
        Set o = Sheets(cel.Value) 'définit l'onglet o (provoque une erreur si l'onglet n'esxiste pas, cel.value = 4 par exemple)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err = 0 'annule l'erreur
            MsgBox "L'onglet " & cel.Value & " n'existe pas !" 'message
            GoTo suite 'passe à la cellule suivante via l'étiquette "suite"
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        b.Range("W8").Value = o.Range("F43") 'la cellule W8 de l'onglet "BUDGET" prend la valeur de la cellule F43 de l'onglet o (??? W8 est en dehors du tableau)
        o.Range("X8").FormulaR1C1 = "='1'!R[35]C[-16]" 'place une formule en X8 de l'onglet o
        o.Range("X9").Value = "" 'efface la cellule X9 de l'onglet o
        o.Range("Y8").FormulaR1C1 = "='1'!R[35]C[-15]" 'place une formule dans Y8 de l'onglet o
        o.Range("Z8").FormulaR1C1 = "='1'!R[35]C[-14]" 'place une formule dans Z8 de l'onglet o
        o.Range("AA8").FormulaR1C1 = "='1'!R[35]C[-11]" 'place une formule dans AA8 de l'onglet o
        o.Range("AB8").FormulaR1C1 = "='1'!R[35]C[-10]" 'place une formule dans AB8 de l'onglet o
        o.Range("O8").FormulaR1C1 = "='1'!R[41]C[-1]:R[41]C" 'place une formule dans O8 de l'onglet o
    End If 'fin de la condition 1
suite: 'étiquette
Next cel 'prochaine cellule de la boucle
End Sub
 

boulbes7

XLDnaute Nouveau
Re : VBA récupération de données selon les feuilles

Super robert, je savais que je pouvais compter sur toi... c nickel sa marche très bien pour la première celllule par contre sa ne me prend pas en compte la plage de la colonne B et si je tape 2 dans une cellule B20 (par exemple) sa n'ira pas chercher l'onglet 2 et aplliquer ma collecte de donnée dans cette ligne 20 ??
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : VBA récupération de données selon les feuilles

Bonjour Boulbes, bonjour le forum,

En effet j'ai réctifié en mettant :
Code:
Set o = Sheets(CStr(cel.Value))
Qui fait alors référence à la chaîne de caractère "1", "2" ou "3" plutôt qu'à l'index 1, 2 ou 3
J'ai aussi modifié les formules où le nom de l'onglet n'a pas lieu d'apparaître (je pense)...
Le nouveau code :
Code:
Sub copidon()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim o As Object 'déclare la variable o (Onglet)
Dim b As Object 'déclare la variable b (onglet Budget)
Dim cel As Range 'déclare la variable cel (CELlule) 

Set b = Sheets("BUDGET") 'définit l'onglet b ("BUDGET")
With b 'prend en compte l'onglet "BUDGET"
    dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée de la colonne B
    Set pl = .Range("B8:B" & dl) 'définit la plage pl
End With 'fin de la prose en compte de l'onglet "BUDGET"
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Value <> "" Then 'condition 1 : si la cellule n'est pas vide
        On Error Resume Next 'gestion des erreurs (si une erreur est générée, passe à la ligne suivante)
        Set o = Sheets(CStr(cel.Value)) 'définit l'onglet o (provoque une erreur si l'onglet n'esxiste pas, cel.value = 4 par exemple)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err = 0 'annule l'erreur
            MsgBox "L'onglet " & cel.Value & " n'existe pas !" 'message
            GoTo suite 'passe à la cellule suivante via l'étiquette "suite"
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        b.Range("W8").Value = o.Range("F43") 'la cellule W8 de l'onglet "BUDGET" prend la valeur de la cellule F43 de l'onglet o (??? W8 est en dehors du tableau)
        o.Range("X8").FormulaR1C1 = "=R[35]C[-16]" 'place une formule en X8 de l'onglet o
        o.Range("X9").Value = "" 'efface la cellule X9 de l'onglet o
        o.Range("Y8").FormulaR1C1 = "=R[35]C[-15]" 'place une formule dans Y8 de l'onglet o
        o.Range("Z8").FormulaR1C1 = "=R[35]C[-14]" 'place une formule dans Z8 de l'onglet o
        o.Range("AA8").FormulaR1C1 = "=R[35]C[-11]" 'place une formule dans AA8 de l'onglet o
        o.Range("AB8").FormulaR1C1 = "=R[35]C[-10]" 'place une formule dans AB8 de l'onglet o
        o.Range("O8").FormulaR1C1 = "=R[41]C[-1]:R[41]C" 'place une formule dans O8 de l'onglet o
    End If 'fin de la condition 1
suite: 'étiquette
Next cel 'prochaine cellule de la boucle
End Sub
 

boulbes7

XLDnaute Nouveau
Re : VBA récupération de données selon les feuilles

encore merci robert, sa marche pour recolter les données en fonction des noms des onglets par contre maintenant il faudrai qu'il me teste la valeur précédente si <>0 des qu'il trouve ne valeur =0 dans la colonne (AC 8 ; AC 68 ) il se positionne dedans pour recopier les données.
Merci robert


Sub copidon()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim o As Object 'déclare la variable o (Onglet)
Dim b As Object 'déclare la variable b (onglet Budget)
Dim cel As Range 'déclare la variable cel (CELlule)

Set b = Sheets("BUDGET") 'définit l'onglet b ("BUDGET")
With b 'prend en compte l'onglet "BUDGET"
dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée de la colonne B
Set pl = .Range("B8:B" & dl) 'définit la plage pl
End With 'fin de la prose en compte de l'onglet "BUDGET"
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
If cel.Value <> "" Then 'condition 1 : si la cellule n'est pas vide
On Error Resume Next 'gestion des erreurs (si une erreur est générée, passe à la ligne suivante)
Set o = Sheets(CStr(cel.Value)) 'définit l'onglet o (provoque une erreur si l'onglet n'esxiste pas, cel.value = 4 par exemple)
If Err <> 0 Then 'condition 2 : si une erreur a été générée
Err = 0 'annule l'erreur
MsgBox "L'onglet " & cel.Value & " n'existe pas !" 'message
GoTo suite 'passe à la cellule suivante via l'étiquette "suite"
End If 'fin de la condition 2
On Error GoTo 0 'annule la gestion des erreurs
b.Range("W8").Value = o.Range("F43") 'la cellule W8 de l'onglet "BUDGET" prend la valeur de la cellule F43 de l'onglet o (??? W8 est en dehors du tableau)
b.Range("X8").Value = o.Range("H43")
b.Range("Y8").Value = o.Range("J43")
b.Range("Z8").Value = o.Range("L43")

End If 'fin de la condition 1
suite: 'étiquette
Next cel 'prochaine cellule de la boucle
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : VBA récupération de données selon les feuilles

Bonjour Boulbes, bonjour le forum,

encore merci robert, sa marche pour recolter les données en fonction des noms des onglets par contre maintenant il faudrai qu'il me teste la valeur précédente si <>0 des qu'il trouve ne valeur =0 dans la colonne (AC 8 ; AC 68 ) il se positionne dedans pour recopier les données.
Merci robert

Bulbes, on va pas s'en sortir si tu manques de précision ! La colonne AC de quel onglet ? pour recopier quelles données de quel onglet ? Ça me fatigue d'être obliger d'interpréter tes non-dits. Fait un petit effort d'explication et ça ira beaucoup plus vite... Si tu me dis par exemple : Je veux recopier la ligne x (de la colonne B à la colonne AA) de l'onglet 1 dans la première ligne vide de la colonne AC de l'onglet BUDGET, je comprend de suite...
 

boulbes7

XLDnaute Nouveau
Re : VBA récupération de données selon les feuilles

excuse moi c'est vrai je suis pas précis sur le dernier coup.
je veux que quand je tape un chiffre( qui sera le numéro d'un onglet) dans la colonne B (plage de B8 à B---) la macro aille me cherche l'onglet correspondant au chiffre taper. une fois dans cet onglet il faut qu'il me récuperer les données F43 H43 J43 L43 et qu'elle me les place dans la feuille budget a W8 X8 Y8 Z8 ( en fasse de la ou j'ai taper le chiffre de l'onglet). Par contre une fois que 1 er ligne dans le tableau dans l'onglet BUDGET est rempli la macro doit descendre d'une ligne afin que si je me place dans la colonne B9 et je saisi 3 la macro aille me chercher dans l'onglet 3 et me récuperer les données F43 H43 J43 L43 mais me les place à la suite (W9 X9 Y9 Z9).

Encore désolé pour mon manque de précision et merci pour ton aide
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : VBA récupération de données selon les feuilles

Bonjour Boulbes, bonjour le forum,

Bon, changement de cap... Maintenant la macro s'éxécute automatiquement chaque fois que tu tapes une valeur dans la plage B8:B66 de l'onglet BUDGET grâce à la macro événementielle Change ci-dessous :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'si le changement à lieu ailleurs que dans la plage B8:B68, sort de la procédure
If Application.Intersect(Target, Range("B8:B68")) Is Nothing Then Exit Sub
'si la cellule est effacée ou la sélection contient plus d'une seule cellule, sort de la procédure
If Target.Value = "" Or Selection.Cells.Count > 1 Then Exit Sub
On Error Resume Next 'gestion des erreurs (si une erreur est générée, passe à la ligne suivante)
Set o = Sheets(CStr(Target.Value)) 'définit l'onglet o
If Err <> 0 Then 'condition 2 : si une erreur a été générée
    Err = 0 'annule l'erreur
    MsgBox "L'onglet " & Target.Value & " n'existe pas !" 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition 2
On Error GoTo 0 'annule la gestion des erreurs
li = Target.Row 'définit la ligne li
Module2.copidon 'lance la procédure "copidon" du module "Module2"
End Sub

Elle définit l'onglet cible o, la ligne li de référence puis lance la macro ci-dessous:
Code:
Public li As Integer 'déclare la variable li (LIgne)
Public o As Object 'déclare la variable o (Onglet)

Sub copidon()
Dim b As Object 'déclare la variable b (onglet Budget)

Set b = Sheets("BUDGET") 'définit l'onglet b ("BUDGET")
b.Cells(li, 23).Value = o.Range("F43") 'la cellule W/li de l'onglet "BUDGET" prend la valeur de la cellule F43 de l'onglet o
b.Cells(li, 24).Value = o.Range("H43") 'la cellule X/li de l'onglet "BUDGET" prend la valeur de la cellule H43 de l'onglet o
b.Cells(li, 25).Value = o.Range("J43") 'la cellule Y/li de l'onglet "BUDGET" prend la valeur de la cellule J43 de l'onglet o
b.Cells(li, 26).Value = o.Range("L43") 'la cellule Z/li de l'onglet "BUDGET" prend la valeur de la cellule F43 de l'onglet o
o.Range("X8").FormulaR1C1 = "=R[35]C[-16]" 'place une formule en X8 de l'onglet o
o.Range("X9").Value = "" 'efface la cellule X9 de l'onglet o
o.Range("Y8").FormulaR1C1 = "=R[35]C[-15]" 'place une formule dans Y8 de l'onglet o
o.Range("Z8").FormulaR1C1 = "=R[35]C[-14]" 'place une formule dans Z8 de l'onglet o
o.Range("AA8").FormulaR1C1 = "=R[35]C[-11]" 'place une formule dans AA8 de l'onglet o
o.Range("AB8").FormulaR1C1 = "=R[35]C[-10]" 'place une formule dans AB8 de l'onglet o
o.Range("O8").FormulaR1C1 = "=R[41]C[-1]:R[41]C" 'place une formule dans O8 de l'onglet o
End Sub

Tu remarqueras dans le module Module2 la déclaration publique des deux variables o et li qui permet de les définir dans la macro événementielle de l'onglet BUDGET et d'utiliser leur valeur dans la macro copidon.

Le fichier :
 

Pièces jointes

  • Boulbes_v01.xls
    220 KB · Affichages: 68

Discussions similaires

Statistiques des forums

Discussions
312 524
Messages
2 089 322
Membres
104 119
dernier inscrit
karbone57