XL 2021 Classer des cellules dans des feuilles spécifiques

HamoudaBA

XLDnaute Occasionnel
Bonjour le fil,
Ayant un tableau de base nommé feuil1;
Je cherche à classer (copier) les valeur de B (matricules) dans la feuille correspondante renseigné dans Feuil 1 (C).
Exemple: B2 correspond à 1 en colonne C, donc copier B2 dans feuille (1) en B2
B5 " à 1 en B3
B2 à 4 feuille (4) en B2

Je vous remercie
 

Pièces jointes

  • test 10.xlsx
    20.4 KB · Affichages: 9

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Hamouda,
Un essai en PJ avec cette petite macro :
VB:
Sub Distribuer()
    Dim T, T2, i%, j%, DL%, L%
    T = Range("A2:C" & Range("A65500").End(xlUp).Row): DL = UBound(T)
    For i = 1 To 4
        ReDim T2(1 To DL, 1 To 2): L = 1
        For j = 1 To DL
            If T(j, 3) = i Then
                T2(L, 1) = T(j, 1): T2(L, 2) = T(j, 2): L = L + 1
            End If
        Next j
        With Sheets(CStr(i))
            .[A2:B10000].ClearContents
            .[A2].Resize(UBound(T2, 1), UBound(T2, 2)) = T2
        End With
    Next i
End Sub
 

Pièces jointes

  • test 10.xlsm
    20 KB · Affichages: 1

Dranreb

XLDnaute Barbatruc
Bonjour.
J'y vais de la mienne aussi.
VB:
Option Explicit
Private Sub Worksheet_Deactivate()
   Dim SGrAffec As SsGr, TR(), L As Long, Detail
   For Each SGrAffec In Gigogne([B2:C2], 2, , 1)
      ReDim TR(1 To SGrAffec.Count, 1 To 1)
      L = 0
      For Each Detail In SGrAffec.Co
         L = L + 1: TR(L, 1) = Detail(1)
         Next Detail
      With Worksheets(CStr(SGrAffec.Id)).[B2]
         .Resize(1000).ClearContents
         .Resize(UBound(TR, 1)).Value = TR
         End With
      Next SGrAffec
   End Sub
 

Pièces jointes

  • GigogneHamoudaBA.xlsm
    57.6 KB · Affichages: 4

HamoudaBA

XLDnaute Occasionnel
Bonjour à vous tous,
Je vous remercie vivement de votre aide et surtout de vos interventions si rapides;
J'ai trouvé l'utilisation de la formule de JHA la plus simple à adapter à mon fichier réel, toutefois j'ai testé les autres éssais en mode vba de Cousinhub, Sylvanu et Dranreb que j'ai apprécié et sauvegardé pour d'autres utilisations.
Chapeau bas à vous tous.
 

job75

XLDnaute Barbatruc
Bonjour le forum,

Curieux que personne n'ait proposé de paramétrer les feuilles ni d'utiliser le filtre automatique.

Le code dans ThisWorkbook :
VB:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Application.ScreenUpdating = False
Sh.Rows("2:" & Sh.Rows.Count).Delete 'RAZ
With Sheets("Feuil1").[A1].CurrentRegion
    .AutoFilter
    .AutoFilter 3, Sh.Name 'filtre automatique
    .Copy [A1]
    .AutoFilter 'ôte le filtre
End With
Columns(3).Clear
End Sub
A+
 

Pièces jointes

  • Filtrer.xlsm
    20.8 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
312 209
Messages
2 086 274
Membres
103 168
dernier inscrit
isidore33