VBA Recopie sélective de cellules sur une autre feuille

fb62840

XLDnaute Impliqué
Bonjour à toutes et tous,

Pourriez-vous me proposer une solution de modification du code ci-dessous pour obtenir le résultat suivant ?

Sur une feuille base, j'ai une série d'enregistrement individuels de type (nom, prénom, référence, structure, adresse, ville, cp, Contact, Téléphone)

J'aimerais modifier le code ci-dessous (source Hasco) afin d'obtenir la recopie non pas de toute les lignes mais d'une seule ligne pour une même "Structure", je m'explique :

Si par exemple on a 5 lignes sur la feuille Base dans laquelle apparaît en Colonne Structure (Colonne D) alors, j'aimerais provoquer la recopie sur la feuille de destination Une seule ligne reprenant :
Structure, Adresse, Ville, Code Postal

Le code ci-dessous recopie toutes les cellules de la feuille d'origine sur la base d'un critère de nom de feuille
J'ignore comment le modifier pour n'obtenir qu'une ligne et qu'une partie des données seulement
Code:
Sub Extraire()
Dim plg As Range, f As Worksheet
    'déterminer la plage à extraire dans Base
    With Sheets("Archers inscrits")
        Set plg = .Range("A1:I" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    
    'Boucler sur toutes les feuilles du classeurs
    For Each f In ThisWorkbook.Sheets
        'Si le nom de la feuille commence par 'CLUB ' (espace compris)
        If f.Name Like ("CLUB *") Then
            'nettoyer toutes les cellules de la feuille
            f.Cells.ClearContents
            'préparation du critère de filtrage avancé
            f.Range("A1") = "Catégorie"
            'critère basé sur la fin du nom de la feuille
            f.Range("A2") = "=""=" & Replace(f.Name, "CLUB ", "") & """"
            'Extraction des données
            plg.AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=f.Range("A1:A2"), CopyToRange:=f.Range("A4:I4"), Unique:=False
            'destruction des lignes de critère et séparation
            'f.Rows("1:3").EntireRow.Delete
        End If
    Next
End Sub

Merci beaucoup pour votre aide.
 
G

Guest

Guest
Re : VBA Recopie sélective de cellules sur une autre feuille

Bonjour,

Ta demande n'a rien à voir avec celle d'hier, donc les méthodes de traitement non plus, donc le fichier exemple non plus.

Dans la phrase:
Si par exemple on a 5 lignes sur la feuille Base dans laquelle apparaît en Colonne Structure (Colonne D) alors, j'aimerais provoquer la recopie sur la feuille de destination Une seule ligne reprenant :
Structure, Adresse, Ville, Code Postal

...dans laquelle apparaît ??? en colonne Structure.
apparaît Quoi?

A+
 

fb62840

XLDnaute Impliqué
Re : VBA Recopie sélective de cellules sur une autre feuille

Bonjour,

Oui en effet, mon message écrit tel qu'il l'est n'a pas de sens.

Voici plus de précision

Si par exemple on a 5 lignes sur la feuille Base dans laquelle apparaît en Colonne Structure (Colonne D)
le critère Crit1 ou Crit2 ou Crit3 ou Crit4 ou Crit5 ou Crit6 ou Crit7
alors, j'aimerais provoquer la recopie sur la feuille de destination :
<8,pour Crit 1, et <10 pour Crit2, <12 Crit3, <15 Crit4, <18 Crit5, <50 Crit6 et >= 50 Crit7
De ces données mais une seule fois seulement par Nom de Structure :
Une colonne avec l'info : Structure, une colonne avec l' Adresse, une colonne avec la Ville, et une colonne avec le Code Postal

Exemple :
Si sur la feuille Base j'ai trois lignes dans lesquelles apparaissent en Colonne D le Critère "<10" et dans lesquelles apparaît dans la colonne intitulée "Structure" j'ai 2 fois le nom "Structure 1" et une fois le nom "Structure 2")
alors sur la feuille <10 seraient créées 2 lignes :
L'une avec en colonne Structure : "Structure1" et les données Adresse, Ville, Code postal
L'une avec en colonne Structure : "Structure2" et les données Adresse, Ville, Code postal

J'espère que c'est plus clair ainsi.

Le code ci-dessous recopie toutes les cellules de la feuille d'origine sur la base d'un critère de nom de feuille
 

Discussions similaires

Statistiques des forums

Discussions
312 202
Messages
2 086 180
Membres
103 152
dernier inscrit
Karibu