copier des cellules remplis

[djuju]

bonjour
je voudrais dans le tableau feuil1 que tout les articles ou il y a eu une non conformité de mise dans les 2 tableau feuil2 et feuil3 soit mis dans le tableau feuil1 avec l'article correspondant a cote
merci

 

[CISCO]

Re : copier des cellules remplis

Bonsoir

Une possibilité en pièce jointe, avec une formule matricielle (longue) à valider avec ctrl+maj+entrer.

@plus

 

[job75]

Re : copier des cellules remplis

Bonsoir djudju, CISCO,

Je n'ai peut-être rien compris 😕

=SI(B3="";"";SI(NB.SI(Feuil2!A:A;B3);RECHERCHEV(B3;Feuil2!A:B;2;0);SI(NB.SI(Feuil3!B:B;B3);RECHERCHEV(B3;Feuil3!B:C;2;0);"")))

Fichier joint.

Edit : oui rien compris car pas vu les formules en colonne A...

A+

 

[djuju]

Re : copier des cellules remplis

bonsoir
oui c'est un peu dur
alors voila je vous donne le vrai tableau car j'ai eu du mal a transposer la formule sur le vrai
alors je voudrais dans mon tableau feuil consultation que les iem non conforme sur les 4 autres feuilles soit transposer sur celui ci ( item audite et nature de non conformite )
voila j'espere avoir ete assez clair
merci encore

 

[CISCO]

Re : copier des cellules remplis

Bonsoir

Toujours avec une formule matricielle, un peu plus longue encore...

@ plus

P.S1 : Ne pas oublier d'aller voir la définition des noms pour comprendre la formule.

P.S2 : Si je trouve plus simple... je reviendrai poster.

 

[job75]

Re : copier des cellules remplis

Bonjour djuju, CISCO, le forum,

Une solution VBA tout à fait classique :

Option Explicit
Option Compare Text 'la casse n'a pas d'importance

Sub Synthese()
Dim w As Worksheet, cel As Range, tablo$(), n&
For Each w In Worksheets
  If w.Name Like "audit*" Then
    For Each cel In w.[D:D].SpecialCells(xlCellTypeConstants)
      If Not cel Like "nature de non*" Then
        ReDim Preserve tablo(1, n)
        tablo(0, n) = cel.Offset(, -2)
        tablo(1, n) = cel
        n = n + 1
      End If
    Next
  End If
Next
Sheets("CONSULTATION").[C80:D10000].ClearContents
If n Then Sheets("CONSULTATION").[C80].Resize(n, 2) = Application.Transpose(tablo)
End Sub

Fichier .xls joint.

A+

 

[job75]

Re : copier des cellules remplis

Re,

En fait pas besoin de bouton, la macro se lance quand on active la feuille CONSULTATION.

Clic droit sur l'onglet et Visualiser le code :

Option Explicit
Option Compare Text 'la casse n'a pas d'importance

Private Sub Worksheet_Activate()
Dim w As Worksheet, cel As Range, tablo$(), n&
For Each w In Worksheets
  If w.Name Like "audit*" Then
    For Each cel In w.[D:D].SpecialCells(xlCellTypeConstants)
      If Not cel Like "nature de non*" Then
        ReDim Preserve tablo(1, n)
        tablo(0, n) = cel.Offset(, -2)
        tablo(1, n) = cel
        n = n + 1
      End If
    Next
  End If
Next
[C80:D10000].ClearContents
If n Then [C80].Resize(n, 2) = Application.Transpose(tablo)
End Sub

Fichier (2).

A+

 

[djuju]

Re : copier des cellules remplis

bonjour et merci pour vos recherche
les deux solutions je suis en train de les analyser et je vais voir laquelle je prend
je vais pouvoir enfin finir mon tableau
encore merci
à bientot

 

[job75]

Re : copier des cellules remplis

Re,

Pour en terminer avec VBA, si l'on veut une mise en forme du tableau, écrire :

Application.ScreenUpdating = False
[C80:D10000].Delete xlUp
If n = 0 Then Exit Sub
With [C80].Resize(n, 2)
  .Value = Application.Transpose(tablo)
  .Font.Size = 20 'taille police
  .Borders.LineStyle = 1 'bordures
End With
End Sub

Fichier (3).

Edit : ceci est mieux car évite Application.ScreenUpdating = False :

Range([C80].Offset(n), Cells(Rows.Count, "D")).Delete xlUp
If n = 0 Then Exit Sub
With [C80].Resize(n, 2)
  .Font.Size = 20 'taille police
  .Borders.LineStyle = 1 'bordures
  .Value = Application.Transpose(tablo)
End With

Fichier (3 bis)

A+

 

[CISCO]

Re : copier des cellules remplis

Bonjour à tous, bonjour job75

Une autre solution, toujours avec une formule matricielle, un peu plus facile à comprendre, mais utilisant la même méthode. Il est évident qu'une solution avec macro est mieux adaptée.

@ plus