VBA: coller lignes dans différentes feuilles selon conditions

[SaraBilmem]

Re-Bonjour,

Me voilà de retour avec un autre problème (l'autre n'est toujours pas réglé en fait..mais bon).

Voici mon soucis: (les données de mon fichier sont de longueur variable, c'est pourquoi j'utilise vba)
Si une condition est remplie pour une cellule de la colonne D(= "super" ou ="moyen") alors j'aimerais coller la ligne correspondant à cette cellule de cette feuille (cellules allant de A3:C3 pour D3, A4:C4 pour D4, etc) dans une autre feuille (une pour super, une pour moyen)

Par exemple:
Donc si D4= "Super" Alors A4:C4 de la Feuille 1 va se coller dans la première ligne (de A à C) vide la feuille 2.
Donc si D5= "Super" Alors A5:C5 de la Feuille 1 va se coller dans la première ligne (de A à C) vide la feuille 2. etc

Mais si D4= "Moyen" Alors A4:C4 de la Feuille 1 va se coller dans la première ligne (de A à C) vide la feuille 3.

Pourriez-vous m'aider? Voici un début de code, mes problèmes sont multiples, notamment le fait que je n'arrive qu'à coller un cellule et elles ne sont pas à la suite mais avec 3-4 lignes d'écart. Par ailleurs, vu la mise en page de mon fichier, il faudrait que ce processus de collage ne commence qu'à la ligne 3.

PS: Je ne suis pas douée en VBA, ne me jugez point🙂 et je sens qu'à 1h du mat j'ai mis beaucoup trop d'info🙂

Sub TrucMuche()
 
  
  Dim j As Integer
  Dim EndR As Integer
  
  EndR = Range("A65536").End(xlUp).Row + 1
 
    For j = 1 To Range("A65536").End(xlUp).Row
        j = j + 1
                       
                    If ThisWorkbook.Sheets("Feuille1").Range("D" & j) = "Super" Then
                        ThisWorkbook.Sheets("Feuille2").Range("A" & j & ":" & "C" & j) = ThisWorkbook.Sheets("Feuille1").Range("A" & j & ":" & "C" & j)
                    End If
     Next j

End Sub

 

[Robert]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Bonjour SaraBilmem, bonjour le forum,

En pièce jointe un proposition avec le code ci-dessous :

Sub Macro1()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne A (=1) (à adapter si besoin)
    Set pl = .Range("D2:D" & dl) 'définit la plage pl (à partir de la deuxième ligne, tu modifieras si besoin)
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        Select Case cel.Value 'agit en fonction de la valeur de la cellule cel
            Case "Super" 'cas "Super"
                Set o = Sheets("Feuil2") 'définit l'onglet o
            Case "Moyen" 'cas "Moyen"
                Set o = Sheets("Feuil3") 'définit l'onglet o
        End Select 'fin de l'action en fonction de ...
        'définit la cellule de destination (A3 si A3 est vide, sinon la  première cellule vide de la colonne A)
        Set dest = IIf(o.Range("A3") = "", o.Range("A3"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 3)).Copy dest 'copie et colle les 3 cellules dans dest
    Next cel 'prochaine cellule de la boucle
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub

Le fichier :

 

[SaraBilmem]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Bonsoir/Bonne nuit,

Merci pour le code, je vais tester cela!

PS: Cela me rassure de ne pas être la seule à être debout😀

SaraBilmem

 

[flyonets44]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Bonjour
le fichier de Robert avec un bouton et quelques ajouts mineurs
Cordialement
Flyonets

 

[SaraBilmem]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Merci pour le fichier, en essayant de l'adapter chez moi, j'ai toujours cette erreur "object variable or with block not set" en pointant Set dest = IIf(o.Range("A3").Value = "", o.Range("A3"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))

Je ne comprends pas pourquoi sur l'autre fichier cela fonctionne mais chez moi ça "bug".

Je vous remercie d'avance pour vos lumières.

SaraBilmem

 

[flyonets44]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Bonjour
pour rémédier à ce bug, rassemble le code de ces deux lignes en une seule
et relance la macro.
Cordialement
flyonets

 

[SaraBilmem]

Re : VBA: coller lignes dans différentes feuilles selon conditions

OK merci!

Sara

 

[SaraBilmem]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Ah mais le code était déjà sur un ligne! C'est en collant ici que ça c'est décalé...

 

[SaraBilmem]

Re : VBA: coller lignes dans différentes feuilles selon conditions

Alors, en provenance d'un autre fil car je cherchais une solution à un problème que je pensais autre:

Merci encore pour votre aide

Sara

Sub Macro1()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Application.ScreenUpdating = False 'masque les changements à l'écran
With Sheets("PENSIONERS") 'prend en compte l'onglet "PENSIONERS"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne A (=1) (à adapter si besoin)
    Set pl = .Range("D2:D" & dl) 'définit la plage pl (à partir de la deuxième ligne, tu modifieras si besoin)
    For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
        On Error Resume Next 'gestion des erreur (si erreur pass à la ligne suivante)
        Set o = Sheets(cel.Value) 'définit l'onglet o (génère une erreur si l'onglet n'existe pas)
        If Err <> 0 Then 'condition : si une erreur a été générée
            Err = 0 'annule l'erreur
            MsgBox "La cellule " & cel.Address(0, 0) & " ne contient pas un nom d'onglet valide !" 'message
            GoTo suite 'va à l'étiquette suite
        End If 'fin de la condition
        On Error GoTo 0 'annule la gestion des erreur
        'définit la cellule de destination
        Set dest = IIf(o.Range("A3") = "", o.Range("A3"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        'copie et colle les 3 lignes dans la dest
        .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 3)).Copy dest
suite: 'étiquette
    Next cel 'prochaine cellule de la boucle
End With 'fin de la prise en compte de l'onglet "PENSIONERS"
Application.ScreenUpdating = True
End Sub 'affiche les changements à l'écran