Macro trier copier coller dans autres feuilles

Version imprimable

Bonjour à tous,

Grand débutant en VBA je souhaite faire une macro qui me permettra de trier copier et coller des donnés à la suite dans une autre page.
Plus précisément je souhaite copier les colonnes B à F à partir de la ligne 10 d'une feuille "projet 1" vers une feuille "personne 1" pour chaque ligne de la feuille projet qui vérifie la condition colonne D = "personne 1"
Il y-aura plusieurs projets (différentes feuilles) et plusieurs personnes (différentes feuilles), les valeurs dans les colonnes B à F sont des nombres, textes et dates.

J'ai trouvé un projet similaire et j'ai souhaité testé en commençant par rechercher dans un seule feuille "projet 1". Mon code doit provoquer des bugs car il fonctionne une fois de temps en temps seulement.

Le voici :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 Option Explicit Sub tri() Dim i As Integer Dim DerLigne1 As Integer Dim DerLigne2 As Integer i = 0 For i = 10 To Sheets("PROJET1").Cells(Rows.Count, 4).End(xlUp).Row Select Case Sheets("PROJET1").Cells(i, 4) Case "PERSONNE1" DerLigne1 = Sheets("PERSONNE1").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("PROJET1").Range(Cells(i, 2), Cells(i, 6)).Copy Destination:=Sheets("PERSONNE1").Cells(DerLigneF3, 1) Case "PERSONNE2" DerLigne2 = Sheets("PERSONNE2").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("PROJET1").Range(Cells(i, 2), Cells(i, 6)).Copy Destination:=Sheets("PERSONNE2").Cells(DerLigneF4, 1) End Select Next End Sub
Merci d'avance pour votre aide.

Mike,

07/09/2014, 01h02
Marc-L

Bonjour,

voir ce tutoriel : Les filtres avancés ou élaborés dans Excel …

Bonjour,

Merci pour votre réponse par contre je n'arrive pas à filtrer les informations provenant de deux tableaux (deux pages) différents.
J'ai utilisé le projet VBA existant sur le lien Peut on répéter une seconde opération de filtre qui permette d'exporter le résultat directement à la suite du résultat du premier filtre ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
Private MODULE
' Module contenant les procédures utilisées dans le classeur illustrant le tutoriel Filtres avancés d'excel
Function ExportByFilter(znData As Range, znCriteria As Range, Optional znExport As Range) As Long
 ' Author : Philippe Tulliez http://philippe.tulliez.be
 ' Date : 01/11/2012
 ' Version : 1.0
 ' Procédure d'exportation basée sur le filtre élaboré
 ' Valeur renvoyée : Nombre d'enregistrements exporté
 ' znData     ' Table de données
 ' znCriteria ' Zone des critères
 ' [znExport]   ' Zone d'exportation (si vide Exporte tout, en créant une feuille)
 If znExport Is Nothing Then ' Création de la feuille d'export et coloration en rouge
  Worksheets.Add before:=Sheets(1)
  With Worksheets(1): ActiveCell = .Range("A1"): .Tab.Color = vbRed: End With
  Set znExport = ActiveCell
 End If
 znData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=znCriteria, CopyToRange:=znExport
 ExportByFilter = znExport.CurrentRegion.Rows.Count - 1
End Function
Public Sub ContrlFilterSelection()
 Application.ScreenUpdating = False
 Dim znSelection As Range
 Dim argData As Range, argCriteria As Range, argExport As Range
 Dim row As Byte ' N° de ligne
 Range("pnClearCriteria").Clear
 Set znSelection = Range("dbZnSelection") ' Zone sélection feuille [ControlFilters]
 Set argData = Range("dbZnDataList3") ' Table de données feuille [DataList3]
 Debug.Print znSelection.Address
 row = Range("pSelectionChoice") ' N° sélection dans la liste
 With Application.WorksheetFunction
  ' Zone Critères
  If Len(.Index(znSelection, row, 1)) Then Set argCriteria = Range(.Index(znSelection, row, 1))
  ' Zone Export
  If Len(.Index(znSelection, row, 2)) Then Set argExport = Range(.Index(znSelection, row, 2))
 End With
 Application.ScreenUpdating = True
 MsgBox "Nombre filtré " & ExportByFilter(argData, argCriteria, argExport)
End Sub
Function Formula(rng As Range) As String
 ' Fonction qui renvoie la formule de la cellule se trouvant en rng
 Formula = rng.FormulaLocal
End Function

Merci!