Re : Mise à jour d'une feuille
mon code!!
Private Sub CommandButton1_Click()
Dim ba, bo, be, bi, bu, la, le, li, lo, lu, qe As Long 'Déclaration de variables
Dim Cel, mel, tel, bel, pel, fel, wel, xel, rel, quel, sel As Range 'idem
Application.ScreenUpdating = False 'masquage du raffraichissement de l'écran (gain de temps)
'on va travailler sur la feuille " Feuil2"
With Sheets("Assemblage tables")
['Assemblage tables'!A7:K300].ClearContents
End With
With Sheets("Assemblage tables")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each Cel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If Cel.Value = 8 Then
'calcul de la première ligne vide de la feuille " Feuil2"
ba = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(Cel.Row, 1), Cells(Cel.Row, 50)).Copy .Cells(ba, 1)
End If
'prochaine cellule
Next Cel
End With
With Sheets("Entrepot")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each mel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If mel.Value = 9 Then
'calcul de la première ligne vide de la feuille " Feuil2"
bo = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(mel.Row, 1), Cells(mel.Row, 50)).Copy .Cells(bo, 1)
End If
'prochaine cellule
Next mel
End With
With Sheets("Maintenance")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each tel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If tel.Value = 10 Then
'calcul de la première ligne vide de la feuille " Feuil2"
be = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(tel.Row, 1), Cells(tel.Row, 50)).Copy .Cells(be, 1)
End If
'prochaine cellule
Next tel
End With
With Sheets("Machinage")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each bel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If bel.Value = 7 Then
'calcul de la première ligne vide de la feuille " Feuil2"
bi = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(bel.Row, 1), Cells(bel.Row, 50)).Copy .Cells(bi, 1)
End If
'prochaine cellule
Next bel
End With
With Sheets("Sabl et Peint tables")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each pel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If pel.Value = 6 Then
'calcul de la première ligne vide de la feuille " Feuil2"
bu = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(pel.Row, 1), Cells(pel.Row, 50)).Copy .Cells(bu, 1)
End If
'prochaine cellule
Next pel
End With
With Sheets("Banquettes")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each fel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If fel.Value = 5 Then
'calcul de la première ligne vide de la feuille " Feuil2"
la = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(fel.Row, 1), Cells(fel.Row, 50)).Copy .Cells(la, 1)
End If
'prochaine cellule
Next fel
End With
With Sheets("Emballage")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each wel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If wel.Value = 4 Then
'calcul de la première ligne vide de la feuille " Feuil2"
le = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(wel.Row, 1), Cells(wel.Row, 50)).Copy .Cells(le, 1)
End If
'prochaine cellule
Next wel
End With
With Sheets("Rembourrage Fixe")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each xel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If xel.Value = 3 - 1 Then
'calcul de la première ligne vide de la feuille " Feuil2"
li = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(xel.Row, 1), Cells(xel.Row, 50)).Copy .Cells(li, 1)
End If
'prochaine cellule
Next xel
End With
With Sheets("Rembourrage")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each rel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If rel.Value = 3 Then
'calcul de la première ligne vide de la feuille " Feuil2"
lo = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(rel.Row, 1), Cells(rel.Row, 50)).Copy .Cells(lo, 1)
End If
'prochaine cellule
Next rel
End With
With Sheets("Sabl et Peint chaises")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each sel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If sel.Value = 2 Then
'calcul de la première ligne vide de la feuille " Feuil2"
lu = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(sel.Row, 1), Cells(sel.Row, 50)).Copy .Cells(lu, 1)
End If
'prochaine cellule
Next sel
End With
With Sheets("Assemblage chaises")
'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
For Each qel In Range("F7:F" & [I65000].End(xlUp).Row)
'Si la valeur de la cellule est "50"
If qel.Value = 1 Then
'calcul de la première ligne vide de la feuille " Feuil2"
qe = .[F65000].End(xlUp).Row + 1
'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
Range(Cells(qel.Row, 1), Cells(qel.Row, 50)).Copy .Cells(qe, 1)
End If
'prochaine cellule
Next qel
End With
End Sub
Merci pour vos suggestion je vais les testées tantot pour mon fichier il depasse la limite du forum fais que c ca!!
