Bonjour,
Voilà un test en mode TABLO avec un exemple sur + de 5000 lignes
Option Explicit
Option Base 1
Sub MonoProd()
'Déclaration variable
Dim Tablo()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim lr%, lr2%, lr3%, compteur%, colonne%, ligne%
'Attribution variable
Set Ws1 = Sheets("MONO")
Set Ws2 = Sheets("BOM")
lr = Sheets("MAJ").Range("A" & Rows.Count).End(xlUp).Row
lr2 = Sheets("MONO").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("BOM").Cells(Rows.Count, "A").End(xlUp).Row
'Efface les données des 2 feuilles receveuses
Ws1.Range("A2:C" & lr2 + 1).ClearContents
Ws2.Range("A2:C" & lr3 + 1).ClearContents
'FEUILLE MONO
compteur = 0
For ligne = 1 To lr 'Bouble pour récup. valeur NORM et YTPN
If Cells(ligne, 3).Value = "NORM" Or Cells(ligne, 3).Value = "YTPN" Then
compteur = compteur + 1 'Additionne dans le compteur si valeur trouvée
ReDim Preserve Tablo(3, compteur) 'Redim le TABLO
For colonne = 1 To 3
Tablo(colonne, compteur) = Cells(ligne, colonne) 'Place les données dans le TABLO
Next colonne
End If
Next ligne
With Ws1 'recopie en feuille MONO les données du TABLO
.Range(.Cells(2, "A"), .Cells(compteur + 1, 3)) = Application.Transpose(Tablo)
End With
'FEUILLE BOM (même commentaire que ci-dessus
compteur = 0
For ligne = 1 To lr
If Cells(ligne, 3).Value = "LUMF" Then
compteur = compteur + 1
ReDim Preserve Tablo(3, compteur)
For colonne = 1 To 3
Tablo(colonne, compteur) = Cells(ligne, colonne)
Next colonne
'*************************************************************
'* Si suppression des LUMF dans feuille MAJ, ôter l'apostrophe de la cde ci-dessous - rallonge le code
'Cells(ligne, 1).Resize(1, 3).Delete (xlUp)
'*************************************************************
End If
Next ligne
With Ws2 'recopie en feuille BOM
.Range(.Cells(2, "A"), .Cells(compteur + 1, 3)) = Application.Transpose(Tablo)
End With
Set Ws1 = Nothing 'vide la mémoire
Set Ws2 = Nothing
End Sub
MonoOrBom.xlsm (117,7 Ko)