selectionner

[romuald]

bonjour je souhaiterai savoir comment faire en vba un programme qui selectionne toute les lignes de la feuil 1 dans les cellules de la colonne C valent 50. puis les couper pour les coller sur la feuille 3.

Puis selectionner dans la feuille 1 toutes les lignes dont la cellule C vaut 51 pour les couper et les coller sur la feuille 4.
Et enfin selectionner les lignes non vide de la feuille 1 pour les coller sur la feuille1.


Merci d'avance.

 

[Gorfael]

romuald écrit:

bonjour je souhaiterai savoir comment faire en vba un programme qui selectionne toute les lignes de la feuil 1 dans les cellules de la colonne C valent 50. puis les couper pour les coller sur la feuille 3.

Puis selectionner dans la feuille 1 toutes les lignes dont la cellule C vaut 51 pour les couper et les coller sur la feuille 4.
Et enfin selectionner les lignes non vide de la feuille 1 pour les coller sur la feuille1.

Merci d'avance.

Salut
Comme je ne suis pas sur du nom, j'ai mis les feuilles en variables, ce qui te permettra de changer les noms, sans toucher au programme lui-même :

Sub Réparttition()
'Déclaration
Dim Lig_Fin_1 As Long
Dim Lig_Cour_1 As Long
Dim Lig_Cour_2 As Long
Dim Lig_Cour_3 As Long
Dim Lig_Cour_4 As Long
Dim F_1 As Worksheet
Dim F_2 As Worksheet
Dim F_3 As Worksheet
Dim F_4 As Worksheet

'MEI
'feuilles
Set F_1 = Worksheets('feuil1')
Set F_2 = Worksheets('feuil2')
Set F_3 = Worksheets('feuil3')
Set F_4 = Worksheets('feuil4')
'Pointeurs
Lig_Fin_1 = F_1.Range('c65535').End(xlUp).Row
If F_2.Range('c65535').End(xlUp).Row < 2 Then
Lig_Cour_2 = 1
Else
Lig_Cour_2 = F_2.Range('c65535').End(xlUp).Row + 1
End If
If F_3.Range('c65535').End(xlUp).Row < 2 Then
Lig_Cour_3 = 1
Else
Lig_Cour_3 = F_3.Range('c65535').End(xlUp).Row + 1
End If
If F_4.Range('c65535').End(xlUp).Row < 2 Then
Lig_Cour_4 = 1
Else
Lig_Cour_4 = F_4.Range('c65535').End(xlUp).Row + 1
End If

'Programmme
For Lig_Cour_1 = 1 To Lig_Fin_1
Select Case F_1.Cells(Lig_Cour_1, 3)
Case 50
F_1.Rows(Lig_Cour_1).Cut
F_3.Select
Cells(Lig_Cour_3, 1).Select
ActiveSheet.Paste
Lig_Cour_3 = Lig_Cour_3 + 1
Case 51
F_1.Rows(Lig_Cour_1).Cut
F_4.Select
Cells(Lig_Cour_4, 1).Select
ActiveSheet.Paste
Lig_Cour_4 = Lig_Cour_4 + 1
Case Else
F_1.Rows(Lig_Cour_1).Cut
F_2.Select
Cells(Lig_Cour_2, 1).Select
ActiveSheet.Paste
Lig_Cour_2 = Lig_Cour_2 + 1
End Select
Next Lig_Cour_1
End Sub

le nom des feuilles (feuil1, feuil2, ...) peuvent être modifiés.
A+

 

[romuald]

merci beaucoup ca marche nickel.

Passe une bonne journee