Filtre cellule non vide classeur dans même onglet

Bonjour à tous,

Pour commencer, je vous présente tous mes vœux de bonheur pour cette nouvelle année.

Je vous contacte pour une petite aide, j'ai un classeur de donner de commande sur plusieurs onglets identiques(même titre de tableau mais ligne différentes).chaque onglets correspond à une zone particulière. certaine ligne de chaque onglets ont la case non vide dans la Colonne "réception"(colonne n°8).

Mon idée est de regrouper dans un même onglet(récapitulatif), la liste des lignes dont la valeur (colonne 8)qui sont non vide pour tout les onglets et indiqué dans la dernière colonne du résultat la référence dès ligne ou ça se trouve dans les onglets respectifs.

Est-ce possible de m'aider à faire cela ? Je vous remercie

Bonsoir,

Un petit fichier aurait été le bien venu
Cordialement

Bonjour,

Comme de nombreuses valeurs sont confidentiel pour ma société, je vous ai fait un fichier regroupant mon idée de demande.

Bonjour,

Ci-joint une proposition. Des optimisations sont possibles si vous avez beaucoup de feuilles et que c'est lent.

Ci-après le code utilisé :

Option Explicit

Sub ReGrouper()

  Application.ScreenUpdating = False

  NettoyerRecap

  Dim endRow As Long, mainNR As Long
  Dim wsht As Worksheet, mainWsht As Worksheet
  Dim adrList As Variant

  Set mainWsht = ThisWorkbook.Worksheets("Recap")

  For Each wsht In ThisWorkbook.Worksheets
    If wsht.Name Like "Secteur*" Then
      ' Debug.Print wsht.Name

      With wsht
        ' calcul dimensions
        endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        ' nettoyage du filtre
        .Range(.Cells(2, 1), .Cells(endRow, 10)).AutoFilter
        ' filtre cellules vides
        .Range(.Cells(2, 1), .Cells(endRow, 10)).AutoFilter Field:=10, Criteria1:="="

        ' copie des cellules filtrees
        endRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        mainNR = mainWsht.Cells(mainWsht.Rows.Count, 2).End(xlUp).Offset(2, 0).Row
        With .Range(.Cells(2, 1), .Cells(endRow, 10)).SpecialCells(xlCellTypeVisible)
          .Copy mainWsht.Cells(mainNR, 2)
        End With
        With .Range(.Cells(3, 1), .Cells(endRow, 10)).SpecialCells(xlCellTypeVisible)
          adrList = SeparateAdr(.Cells)
        End With
        ' nettoyage du filtre
        .Range(.Cells(2, 1), .Cells(endRow, 10)).AutoFilter
      End With
      ' ajout du secteur en colonne A
      mainWsht.Cells(mainNR, 1).Value2 = wsht.Name
      ' ajout des adresses en colonne K
      mainWsht.Cells(mainNR, 11).Value2 = "Référence"
      mainWsht.Cells(mainNR + 1, 11).Resize(UBound(adrList) + 1, 1).Value2 = WorksheetFunction.Transpose(adrList)

    End If
  Next wsht

  Application.ScreenUpdating = False
End Sub

Private Sub NettoyerRecap()
  With ThisWorkbook.Worksheets("Recap").Range("A:K")
    .ClearContents
    .ClearFormats
  End With
End Sub

'Sub AjoutLien(inSht As Worksheet, rowI As Long, searchedSht As Worksheet)
'
'End Sub

Private Function SeparateAdr(rng As Range) As Variant
  Dim adrList As Object
  Set adrList = CreateObject("System.Collections.Arraylist")
  Dim iterC As Range
  For Each iterC In rng
    ' 8 = colonne H, pour l'adresse
    If iterC.Column = 8 Then adrList.Add iterC.Worksheet.Name & " " & iterC.Address(False, False)
  Next iterC

  SeparateAdr = adrList.ToArray
End Function

Merci pour ce code qui marche bien.

J'essaie de l'adapter a mon fichier originale mais ça coince un peu.

Je voudrais au lieu de

If wsht.Name Like "Secteur*" Then

effectuer le traitement par rapport à une liste qui correspond au onglets correspondant.

Exemple : Onglet référence: colonne A --> la liste des onglets a traiter par le code.

Le traitement se fera par rapport à cette liste et rien d'autre, je pense que ce la est facile pour vous avec une boucle mais j'arrive pas à la mettre en place.

Bonjour,

Ci-joint le fichier MAJ pour correspondre à votre demande. Dans la feuille "Référence" il y a un tableau structuré en colonne A, c'est très important : c'est là que sont recherchés les noms de feuille. Pensez à l'étendre vers le bas si vous en rajoutez.

Vous pouvez aussi lui donner un nom plus spécifique (comme "tblRefs" par exemple) et dans le code ci-dessous, MAJ comme ceci :

Private Function EstReference(secteur As String) As Boolean
  ' se refere au tableau 1 de la feuille "Référence"
  EstReference = Not (ThisWorkbook.Worksheets("Référence").ListObjects(1).DataBodyRange.Find(secteur) Is Nothing)
' MAJ possible avec nom du tableau structuré
' EstReference = Not (ThisWorkbook.Worksheets("Référence").ListObjects("tblRefs").DataBodyRange.Find(secteur) Is Nothing)
End Function

Si le nom de la feuille change, c'est le même principe : tout se passe dans cette petite fonction.

Bonne journée.

oh Top 👌👌👌

Merci beaucoup.

Merci pour votre retour, heureux de pouvoir aider. Bonne journée.