Boucle sur caption onglets, puis rechercheV, puis collage du resultat

[sim]

Bonjour a tous,

J'ai essaye par moi meme mais je n'y arrive pas, voila donc le soucy:

J'ai un classeur contenant une 50aine d'onglets, chaque nom d'onglet est un pays
J'ai un tableau dont la premiere colonne j'ai le nom des pays

Dans le tableau, un pays peux avoir 3 lignes, d'autre 2 lignes etc (mais pas beaucoup plus)

J'aimerai construire une boucle sur le nom des onglet et quand la propriete caption est = au nom du pays dans le tableau, coller les ligne correspondantes dans une cellule, qui est toujours la meme. Le soucy est qu'il faut repeter le titre du tableau a chaque fois.

J'ai nomme mes plage "tablo" et "titre"

Je vous joint un exemple pour plus de simplicite.

Merci d'avance pour le coup de main 🙂

Sim

 

[Robert]

Re : Boucle sur caption onglets, puis rechercheV, puis collage du resultat

Bonjour Sim, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim dl As Long 'déclare la variable dl (dernière Ligne)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim o As Worksheet 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim suite As Range 'déclare la variable suite (cellule de SUITE)
 
dl = Sheets("Tableau").Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne
For Each cel In Sheets("Tableau").Range("A2:A" & dl) 'boucle sur toutes les cellule éditée cel de la clonne A de l'onglet "Tableau"
    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 (génère une erreur si la cellule est vide ou si elle contient un nom ne correspondant pas au nom d'un onglet du classeur)
    If Err > 0 Then GoTo suite 'si une erreur est générée va à l'étiquette "suite"
    Set dest = o.Range("B4") 'définit la cellule de destination
    If dest.Value = "" Then Range("titre").Copy dest 'si dest est vide, copy le titre
    Set suite = cel 'définit la cellule de suite
    Do 'exécute
        Set dest = o.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, -1) 'redéfinit la cellule de destination
        Range(suite, suite.Offset(0, 3)).Copy dest 'copie les données
        Set suite = suite.Offset(1, 0) 'redéfinit la cellule de suite
        If suite.Row > dl Then Exit Sub 'si la ligne de la cellule de suite est suppérieure à la dernière ligne du tableau, sort de la procédure
    Loop Until suite.Value <> "" 'boucle tant que la cellule de suite n'est pas vide
 
suite: 'étiquette
    On Error GoTo 0 'annule la gestion des erreur
Next cel 'prochaine cellule de la boucle
End Sub

 

[sim]

Re : Boucle sur caption onglets, puis rechercheV, puis collage du resultat

Waaaa,

Merci beaucoup Robert, ca marche nikel!!


Bonne journee a toi et encore merci!

Sim