exporter des données de plusieurs feuilles d'un classeur avec plusieurs conditions

[minierossi46]

Bonjour à tous,

je viens vers vous car au boulot on me demande de faire une chose dont je suis incapable...😕
je vous explique: j'ai une feuille nommée EXTRACTION sur laquelle j'ai plusieurs colonnes dons une colonne "comptable" (nom des comptables) à laquelle sont rattachés des adhérents, une deuxième feuille sur laquelle le nom des comptables est rattaché à son agence (il y a plusieurs agences)
j'ai donc crée une feuille par agence et je souhaite que excel exporte les données présentes dans la feuille 1 (EXTRACTION) vers chaque feuille d'agence en fonction du nom du comptable qui donc est rattaché à une agence grâce a la feuille 2.

J'espère avoir été assez clair

merci de votre aide🙂

 

[JCGL]

Re : exporter des données de plusieurs feuilles d'un classeur avec plusieurs conditio

Bonjour à tous,

Bienvenue sur XLD

Merci de relire la Charte qui recommande le dépôt d'un bout de fichier anonymisé et significatif.

A+ à tous

 

[minierossi46]

Re : exporter des données de plusieurs feuilles d'un classeur avec plusieurs conditio

bonjour,
voici l'exemple demandé

🙂

 

[JCGL]

Re : exporter des données de plusieurs feuilles d'un classeur avec plusieurs conditio

Bonjour à tous,

Un essai en cliquant sur le bouton :

Option Explicit
Sub Ventilation()
     Dim Sh As Worksheet
    Dim Cel As Range
    Dim DerLig As Long
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    For Each Sh In Sheets
        If Sh.Name <> "Data" And Sh.Name <> "Modèle" Then
            Sh.Delete
        End If
    Next Sh
    Sheets("Modèle").Visible = True
    With Sheets("Data")
        Columns("A:T").Select
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("E2:E10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange Range("A1:T10000")
        .Sort.Header = xlYes
        .Sort.MatchCase = False
        .Sort.Orientation = xlTopToBottom
        .Sort.SortMethod = xlPinYin
        .Sort.Apply
        Range("A1").Select
        DerLig = .[A65000].End(xlUp).Row
        .Range("A1:T" & DerLig).Name = "Base"
        .[Z1] = .[E1]
        .Range("E1:A" & DerLig).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("Z1"), Unique:=True
        For Each Cel In .Range("Z2:Z" & .[Z65000].End(xlUp).Row)
            If Cel.Value <> "" Then
                .[Z2] = Cel.Value
                Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = Cel.Value
                .Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("Z1:Z2"), _
                                              CopyToRange:=Range("A1:T1"), Unique:=False
                ActiveSheet.Cells.EntireColumn.AutoFit
            End If
            Cells(1, 1).Select
        Next Cel
        .Columns(26).Clear
        .Select
    End With
    Sheets("Data").[A1].Select
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    Sheets("Modèle").Visible = False
End Sub

A+ à tous