XL 2019 EXCEL-VBA : Besoin de copier coller sous condition

[mikado08]

Bonjour à tous,

j'ai exploré plusieurs forum à la recherche des infos manquantes mais je ne suis pas assez callé en VBA pour adapter à mon besoin.

Je souhaite copier coller une ligne de A à O si dans la colonne A cela contient un "x" sur une autre feuille

qui va se copier avant mon Total HT.

je perd espoir de trouver un début de quelque chose tout seul :'(

 

[fanch55]

Bonjour,

Je souhaite copier coller une ligne de A à O si dans la colonne A cela contient un "x" sur une autre feuille

Où sont les colonnes A à O ? un "x" dans la colonne A d' une autre feuille ; c'est quoi la référence à la ligne de la première feuille ?

Ce qui est fourni est plutôt "minimaliste" pour vous fournir une réponse correcte .
Auriez-vous une classeur exemple ?

 

[mikado08]

Bonjour,

Où sont les colonnes A à O ? un "x" dans la colonne A d' une autre feuille ; c'est quoi la référence à la ligne de la première feuille ?

Ce qui est fourni est plutôt "minimaliste" pour vous fournir une réponse correcte .
Auriez-vous une classeur exemple ?

voila en gros au lieu de rajouter des lignes a chaque fois
je voudrais avec une feuille "RUBRIQUES TYPE" pour la quand je met un "x" en A ca copie la ligne vers la feuille "Débours" mais avant le total HT et sans que ca écrase d'autre ligne qui serait déja la... c'est la que je bute

 

[mikado08]

Sub CopieDonnees()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne As Long
    'On définit les mots clés
    MotCle = Array("x", "X", "1")
    'On effectue la recherche de chaque mot clé dans la colonne A de la feuille "RUBRIQUES TYPE"
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("RUBRIQUES TYPE").Columns(1).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'On définit le nom de la feuille où sera effectuée la copie
                F = "Débours"
                With Worksheets(F)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    'C.EntireRow.Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
End Sub

j'ai reprise un code qui appriorie devrait marché sur la partir C/C après la destination du collage dans la feuille cible à revoir... mais pourtant cela plante j'ai du faire une boucle infinie je ne vois pas ou

 

[fanch55]

Mdp sur le VB du classeur fourni ...
Mais d'après l'analyse du code fourni,
Le find effectue une boucle sans fin car il retourne au début quand il a atteint la fin ...

Le code suivant devrait fonctionner:

Option Explicit
Sub CopieDonnees()
Dim MotCles     As Variant
Dim C           As Range
Dim F           As Worksheet
Dim C_Address   As String
Dim Ligne       As Long
    ' mots clés pour copier
    MotCles = Array("x", "X", "1")
    ' recherche des cellules non vides dans la colonne A de la feuille "RUBRIQUES TYPE"
    Set C = Worksheets("RUBRIQUES TYPE").Columns(1).Find("*", LookIn:=xlValues, lookat:=xlWhole)
    Do While Not C Is Nothing
        If C_Address = "" Then C_Address = C.Address
       ' Traitement si C est dans MotCles
        If UBound(Filter(MotCles, C, True, vbTextCompare)) >= 0 Then
            'nom de la feuille où sera effectuée la copie
            Set F = Worksheets("Débours")
            'ligne où sera effectué le collage
            Ligne = F.Range("A" & F.Rows.Count).End(xlUp).Row + 1
            'On effectue le copier / coller
            C.EntireRow.Copy F.Range("A" & Ligne)
            'On supprime la ligne dans la sheet1
            'C.EntireRow.Delete
        End If
        Set C = Worksheets("RUBRIQUES TYPE").Columns(1).FindNext(C)
        If C.Address = C_Address Then Set C = Nothing
    Loop
End Sub

 

[fanch55]

J'ai copié les 2 feuilles dans un nouveau classeur ( pour bypasser le mdp ).
et défini une zone nommée :

Le classeur joint est une possibilité de copie