Copier colonnes d'une ligne sous condition

Bonjour le forum !

J'ai, tant bien que mal, réussi à bricoler une macro à l'aide de bouts de code trouvés ici et là.

Cette macro me permet de boucler sur tous les onglets de mon classeur, et vérifie le contenu de la colonne "AG" pour chaque ligne de mes onglets.

Si la colonne "AG" de mes lignes contient le mot "RELANCE" alors, la macro me copie les lignes sur l'onglet "Extraction".

Ma question est la suivante, peut-on, selon la condition mentionnée ci-dessus, copier seulement quelques colonnes et non pas la ligne entière ?

Si la colonne "AG" contient "RELANCE" alors seulement copier les colonnes B, C, D, E, G, H de la ligne ?

Voici mon morceau de code :

Sub extraire()

Dim i As Integer
Dim ligne As Integer
Dim destination As Worksheet
Dim f As Worksheet
Dim derlig As Integer

    For Each f In Worksheets
        If f.Name <> "Extraction" And f.Name <> "Base"  Then
            Set destination = Worksheets("Extraction")
                ligne = 2

        For i = 3 To f.[b65536].End(xlUp).Row
            If f.Cells(i, 33).Value = "RELANCE" Then
                ligne = Worksheets("Extraction").[A65536].End(xlUp).Row + 1
                f.Range(f.Cells(i, 1), f.Cells(i, 33)).Copy destination.Cells(ligne, 10)

        End If
         Next
            End If
         Next f
End Sub

Si quelqu'un peut me venir en aide...

Merci beaucoup !

Salut,

Voici déjà une réponse par rapport à ta demande.

Comme dans le fichier ci-joint, remplace la ligne

f.Range(f.Cells(i, 1), f.Cells(i, 33)).Copy destination.Cells(ligne, 10) 

par les lignes

 f.Range(f.Cells(i, 2), f.Cells(i, 5)).Copy destination.Cells(ligne, 10)
 f.Range(f.Cells(i, 7), f.Cells(i, 8)).Copy destination.Cells(ligne, 14)

Il y aurait quelques autres améliorations à faire dans ton code, mais sans avoir ton fichier réel sous la main - avec des données confidentielles remplacées par des données neutres - ça ne donne pas l'envie de s'investir plus.

Amicalement.

Merci beaucoup Yvouille, je vais essayer

Salut Lucas,

Pour ''essayer'', il te suffit d'ouvrir le fichier que je me suis donné la peine de créer pour toi et de lancer la macro qui y est incluse

Amicalement.

Bonjour,

Une autre proposition à étudier.

Cdlt.

Public Sub Extraire()
Dim ws As Worksheet, rw As Long, lRow As Long
    For Each ws In Worksheets
        If ws.Name <> "Extraction" And ws.Name <> "Base" Then
            For rw = 3 To ws.Cells(Rows.Count, 1).End(xlUp).Row
                If UCase$(ws.Cells(rw, 33).Value) = "RELANCE" Then
                    With Worksheets("Extraction")
                        lRow = .Cells(Rows.Count, 10).End(xlUp).Row + 1
                        .Cells(lRow, 10).Resize(, 4).Value = ws.Cells(rw, 2).Resize(, 4).Value
                        .Cells(lRow, 14).Resize(, 2).Value = ws.Cells(rw, 7).Resize(, 2).Value
                    End With
                End If
            Next rw
        End If
    Next ws
End Sub

C'est évidemment ce que j'ai fait, merci beaucoup Yvouille, ça répond bien à mon problème. Je vais intégrer ceci à mon fichier.

Comme tu dis, le code mérite surement d'être optimisé, mais tant que ça marche comme ça, ça me va. Merci encore !

Bonjour Jean-Eric, merci également pour ta réponse. Je vais tester aussi ce code, qui paraît plus "pro" que le mien !

Bien à vous,

Lucas