#1
#1
Bonsoir,
Je fais face à un blocage sur excel et je vous sollicite afin de me dépanner. Je dispose d'un fichier excel composé d'une 50e de ligne dont je souhaiterais effectuer une macro vba constitué d'une commande conditionnel sur l'une des colonnes de mon tableau (exemple sur la colonne E du fichier que je vais essayer de mettre en pièce jointe).
Mon objectif : SI le texte dans la colonne E = A ALORS copier la ligne entière et me l'inclure dans la feuil1 SINON ne pas l'inclure dans la feuil1.
Sur votre forum, j'ai réussit à retrouver un sujet quasiment similaire à ma demande : https://forum.tomshardware.fr/threads/copier-coller-ligne-complète-si-une-condition-est-respectée.895999/page-5
Par contre celà ne marche pas dans mon cas (sur la feuil 1 figure uniquement la colonne E et pas les lignes dont le fournisseur est A + en prime un message d'erreur est affiché). Ci-dessous ma macro modifiée:
PS : le fichier .xlsm n'est pas autorisé en pièce jointe
Je fais face à un blocage sur excel et je vous sollicite afin de me dépanner. Je dispose d'un fichier excel composé d'une 50e de ligne dont je souhaiterais effectuer une macro vba constitué d'une commande conditionnel sur l'une des colonnes de mon tableau (exemple sur la colonne E du fichier que je vais essayer de mettre en pièce jointe).
Mon objectif : SI le texte dans la colonne E = A ALORS copier la ligne entière et me l'inclure dans la feuil1 SINON ne pas l'inclure dans la feuil1.
Sur votre forum, j'ai réussit à retrouver un sujet quasiment similaire à ma demande : https://forum.tomshardware.fr/threads/copier-coller-ligne-complète-si-une-condition-est-respectée.895999/page-5
Par contre celà ne marche pas dans mon cas (sur la feuil 1 figure uniquement la colonne E et pas les lignes dont le fournisseur est A + en prime un message d'erreur est affiché). Ci-dessous ma macro modifiée:
Code:
Sub test()
Dim cel As Range
Dim source As Range
Dim destination As Range
Worksheets("feuil1").UsedRange.Clear
Set destination = Worksheets("feuil1").Range("B3")
Sheets("TOUS").Range("E6:E96").Copy destination
Set destination = destination.Offset(1, 0)
With Sheets("TOUS")
For Each cel In .Range("g3:g" & .Range("g" & .Rows.Count).End(xlUp).Row)
If cel.MergeCells Then
If source Is Nothing Then
Set source = cel.MergeArea.EntireRow
Else
Set source = Union(source, cel.MergeArea.EntireRow)
End If
ElseIf cel.Value = "A" Then
If source Is Nothing Then
Set source = cel.EntireRow
Else
Set source = Union(source, cel.EntireRow)
End If
End If
Next
End With
source.Copy destination
Worksheets("TOUS").Activate
Worksheets("TOUS").Range("A1").Select
End Sub
Dernière édition par un modérateur: