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
| Dim F as worksheet
Dim i as integer
Dim j as integer
Dim derligne as integer
For each F in Activeworkbook.Worksheets
If (( ucase( left (F.name,2)))="R+" OR (( ucase( left (F.name,3)))="ETA" OR (( ucase( left (F.name,3)))="NIV" OR (( ucase( left (F.name,3)))="SOU" then
For j=1 to Activeworkbook.Worksheets.count
Sheets(j). Select
Lastrow = Range("B1048576").end(xlup).row
For i= lastrow to 4 step -1
Sheets(j). Select
Sheets(I). select
Selection.delete shift:=xlup
Next i
Sheets ("nomenclature_mtx").select
Derligne=Range("B1048576").end(xlup).row
For k= 8 to derligne
Sheets"nomenclature_mtx"). Select
If sheets(j).name=cells(k,6).value then
Rows (k). select
Sélection.copy
Sheets (j). select
Lastrow = Range("B1048576").end(xlup).row+1
Cells(lastrow,1). select
Active sheet.paste
End if
Next k
Next j
Application.cutcopymode= false
Sheets"nomenclature_mtx"). Select
End sub |
Partager