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
Merci beaucoup pour votre aide.
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.