Copier des cellules

[franzy51]

Bonjour j'ai un tableau xl avec des donnés noms prénoms année etc.
je souhaite recopier sur une nouvelle feuille les données année.
J'ai écrit ceci en vba, mais cela ne fonctionne pas

Private Sub Workbook_SheetActivate(ByVal o As Object)
    If o.Name = "Enfants 1 à 3 ans" Then
        Range("a:t").Clear
        With Sheets("listing")
            .[a:t].AutoFilter Field:=8, Criteria1:="2012"
            .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Enfants 1 à 3 ans").[a1]
            .[a:t].AutoFilter
        End With
     Else
        If o.Name = "Enfants 1 à 3 ans" Then
        Range("a:t").Clear
        With Sheets("listing")
            .[a:t].AutoFilter Field:=8, Criteria1:="2013"
            .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Enfants 1 à 3 ans").[a1]
            .[a:t].AutoFilter
        End With
        Else
            If o.Name = "Enfants 1 à 3 ans" Then
        Range("a:t").Clear
        With Sheets("listing")
            .[a:t].AutoFilter Field:=8, Criteria1:="2014"
            .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Enfants 1 à 3 ans").[a1]
            .[a:t].AutoFilter
        End With
            End If: End If: End If
End Sub

Cela n'affiche que 2012 et pas 2013 et 2014.
Merci pour votre aide

 

[Philippe Tulliez]

Re : Copier des cellules

Bonjour,
Si tu souhaites, exporter des données en fonction de critères, je te suggère l'utilisation de la méthode AdvancedFilter de l'objet Range (Voir les filtres avancés d'excel)
Les filtres avancés d'excel sont basés sur une zone des données, une zone des critères et pour la copie, d'une zone d'exportation.

Exemple d'une formule placée dans la zone des critères

=ET(E2=""Ventes"",F2>2000)

Elle doit être en anglais pour le VBA

Code de la procédure

Sub ExportByAdvancedFilter_Exemple_1()
 ' http://philippe.tulliez.be/
 Const myFormula As String = "=AND(E2=""Ventes"",F2>2000)"
 Dim areaSource As Range, areaTarget As Range, areaCriteria As Range
 With ThisWorkbook
  Set areaSource = .Worksheets("Data").Range("A1").CurrentRegion
  Set areaTarget = .Worksheets("Export").Range("A1")
 End With
 ' Zone des critères à 2 colonnes après la zone des données
 With areaSource
  Set areaCriteria = .Offset(columnoffset:=.Columns.Count + 1).Resize(2, 1)
 End With
 ' Ecriture dans la zone des critères
 areaCriteria(1) = "_fn_": areaCriteria(2).Formula = myFormula
 ' Debug.Print "Source = " & areaSource.Address _
 '             & "Export = " & areaTarget.Address _
 '             & " Critère = " & areaCriteria.Address
 ' Suppression des cellules de la feuille cible
 areaTarget.Worksheet.Cells.Clear
 ' Exportation suivant les critères
 areaSource.AdvancedFilter xlFilterCopy, areaCriteria, areaTarget
 ' Suppression de la zone des critères
 areaCriteria.Clear
 ' Suppresion des références aux variables objets
 Set areaSource = Nothing: Set areaTarget = Nothing: Set areaCriteria = Nothing
End Sub

Illustrations des deux feuilles (Source et cible)

 

[Theze]

Re : Copier des cellules

Bonjour,

Une autre piste, avec un tableau de critères mais ne fonctionne qu'à partir d'Excel 2007 :

Private Sub Workbook_SheetActivate(ByVal Fe As Object)

    Dim Plage As Range
    Dim Tbl(1 To 3)

    If Fe.Name <> "Enfants 1 à 3 ans" Then Exit Sub

    Fe.Range("A:T").Clear

    Set Plage = Sheets("listing").Range("A:T")
    
    'tableau ce critères, fonctionne qu'à partir d'Excel 2007 !
    Tbl(1) = "2012": Tbl(2) = "2013": Tbl(3) = "2014"

    With Plage

        .AutoFilter 8, Tbl, xlFilterValues
        Sheets("listing").AutoFilter.Range.Copy Fe.Range("A1")
        .AutoFilter

    End With

End Sub

 

[franzy51]

Re : Copier des cellules

Super cela fonctionne.
Merci pour aide.
Une autre petite question si en plus je veux que tout soit classé par ordre alphabétique, il faut rajouter quoi ?

 

[franzy51]

Re : Copier des cellules

Bonjour,
cela fonctionne, merci.
Par contre une petite question j'ai plusieurs feuilles comment je fais

 

[Theze]

Re : Copier des cellules

Bonjour,

Comme ceci ?

Private Sub Workbook_SheetActivate(ByVal Fe As Object)

    Dim Plage As Range
    Dim Tbl(1 To 3)

    If Fe.Name <> "Enfants 1 à 3 ans" Then Exit Sub

    Fe.Range("A:T").Clear

    Set Plage = Sheets("listing").Range("A:T")
    
    'tableau ce critères, fonctionne qu'à partir d'Excel 2007 !
    Tbl(1) = "2012": Tbl(2) = "2013": Tbl(3) = "2014"

    With Plage

        .AutoFilter 8, Tbl, xlFilterValues
        Sheets("listing").AutoFilter.Range.Copy Fe.Range("A1")
        .AutoFilter

    End With
    
    'tri
    Fe.Sort.SortFields.Clear
    
    With Fe.Range("A1").CurrentRegion
    
        Fe.Sort.SortFields.Add .Range(.Columns(8).Cells(2), .Columns(8).Cells(.Rows.Count)), xlSortOnValues, xlAscending, xlSortNormal
        
    End With
    
    With Fe.Sort
    
        .SetRange Fe.Range("A1").CurrentRegion
        .Header = xlYes
        .Apply
        
    End With
    
End Sub

 

[Theze]

Re : Copier des cellules

Tu as plusieurs feuilles c'est bien mais tu veux faire quoi ?