Discussion :

[Madiaw]

Bonjour et merci d'avance pour votre précieuse aide.
En tant que grand débutant ça fait plusieurs jours que je me casse la tête sur une requête.
J'ai un fichiers de 3 feuilles. Je veux créer une requête via un bouton de commande qui me permet à chaque fois q'une colonne affiche "A DETRUIRE" de couper la ligne correspondante et la coller sur une autre feuille ainsi de suite...
En dessous ce que j'ai fait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub CommandButton1_Click()
Dim iLI As Integer
Dim iRE As Integer
Dim LI As Worksheet
Dim RE As Worksheet
Set LI = Worksheets(1)
Set RE = Worksheets(2)
iRE = 2
For iLI = 4 To 1000
If LI.Cells(iLI, 11).Text = "A DETRUIRE" Then
 RE.Rows(iRE) = RE.Rows(iLI)
'LI.EntireRow(iLI).Copy RE.Range("A1", 11)
iRE = iRE + 1
End If
Do While RE.Cells(iRE, 1).Value <> ""
    iRE = iRE + 1
Loop
Next
End Sub

Comme vous vous en doutez . . . ça ne marche pas et je sais pas quel est le problème
Merci de votre aide

[laetitia]

bonjour Madiaw le forum un exemple enleve ce code dans ton fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Worksheets(1).coloumns(2).Copy
Worksheets(2).coloumns(1).Paste
End Sub

puis...
code du bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
essai
End Sub

la macro dans un module standard attention au nom des feuilles adapte!!

Option Explicit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub essai()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("k3", Range("k65536").End(xlUp))
If c = "A DETRUIRE" Then
c.EntireRow.Cut Destination:=Sheets(2).Range("A65536").End(xlUp)(2)
 End If: Next c
End Sub

[Madiaw]

Merci Laetitia

Mais comment éviter les blancs sur la feuille d'origine après avoir couper et coller les lignes qui contiennent le "A DETRUIRE" ?

[laetitia]

rebonjour essai comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub essai()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("k3", Range("k65536").End(xlUp))
If c = "A DETRUIRE" Then
c.EntireRow.Cut Destination:=Sheets(2).Range("A65536").End(xlUp)(2)
 End If: Next c
Sheets(1).[A4:A65000].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

[Madiaw]

MILLE MILLIARDS DE MILLES MERCI Laetitia

[Madiaw]

Bonjour Laetitia

Je reviens encore une fois bénéficier de tes lumières.
Cette fois ci je souhaite couper et coller une partie au lieu de toute la ligne: de A3 à K3 et la coller sur la feuille 2.

Et sur la feuille 2 j'ai intégré des check box et je souhaiterais afficher la valeur "DETRUIT" sur la colonne K à chaque fois que je coche sur une case.

Je joins le fichier !

Merci d'avance

[Qwazerty]

Salut, leti je me permet j'espère pas dire de bêtise :p

Pour modifier la boucle de Laetitia, remplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub essai2()
Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Range("K3", Cells(Rows.Count, "K").End(xlUp))
        If c = "A DETRUIRE" Then
            With Range(Cells(c.Row, "A"), c)
                .Copy Destination:=Sheets(2).Range("A65536").End(xlUp)(2)
                .ClearContents
            End With
            c.Value = "Desaumons"
        End If
    Next c
    Sheets(1).[A4:A65000].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

[Edit]
J'ai refait mon code il y avait un truc pas top on perdait la mise en forme du tableau, comme ça c mieux je pense
[/Edit]
Ça devrait faire ce que tu souhaites je pense.
A++
Qwaz

[Madiaw]

Merci Qwazerty !

Mais concernant la requête

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets(1).[A4:A65000].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Je ne souhaite supprimer que la plage B2 à L2 par exemple non EntireRow.

As-tu une idée pour les Checkbox ?
Je dois en créer plusieurs et il serait très long de les programmer un par un

Thank U in advance

[laetitia]

re, la macro de l ami Qwaz tu peus la modifier comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub essai()
Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Range("K3", Cells(Rows.Count, "K").End(xlUp))
        If c = "A DETRUIRE" Then
        With Range(Cells(c.Row, "A"), c)
       .Copy Destination:=Sheets(2).Range("A65536").End(xlUp)(2)
       End With
    With Range(Cells(c.Row, "b"), c.Offset(0, 1))
     .Delete
     End With
     End If
    Next c
    End Sub

pour les Checkbox tu en as beaucoup??? peut etre un module de classe!!!!!

[laetitia]

re, le forum un exemple avec un module de classe ce code te permets dans mettre 99 si plus adapter j ai supprimer le CheckBox1 puis j ai mis le CheckBox2 a sa place en L 2 et ainsi de suite jusqu a L 99 il faut pas renommer les CheckBox ex:CheckBox2 CheckBox3 CheckBox4 ect....pour faire simple j utilise la proprietes du caption & non NAME plus simple dans ton cas..
chaque fois que tu vas rajouter un CheckBox il faut lancer la macro initialisation
pour faire simple tu changes de feuille la macro se lance automatiquement avec thisworkbook

code thisworkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Workbook_Open()
Initialisation
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Initialisation
End Sub

dans un module standard

Option Explicit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Buttons() As New Classe1
Public ButtonCount As Byte
Sub Initialisation()
Dim Obj As OLEObject, Ws As Worksheet
ButtonCount = 0
For Each Obj In ActiveSheet.OLEObjects
If TypeOf Obj.Object Is MSForms.CheckBox Then
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons(1 To ButtonCount)
Set Buttons(ButtonCount).ButtonGroup = Obj.Object
End If
Next Obj
End Sub

dans le module de class

Option Explicit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Public WithEvents ButtonGroup As MSForms.CheckBox
Private Sub ButtonGroup_Click()
Dim c As Variant
If Len(ButtonGroup.Caption) = 9 Then c = Right(ButtonGroup.Caption, 1) Else c = Right(ButtonGroup.Caption, 2)
If ButtonGroup = True Then
Cells(c, 11) = "DETRUIT"
Else
Cells(c, 11) = ""
End If

End Sub