Coller cellules dans une autre feuille

Bonjour,

Merci à tous ceux qui pourront me donner un coup de main !

Voilà mon problème: j'ai créé un classeur qui regroupera toutes les informations arrivant à l'accueil de mon lieu de stage. Le but étant de savoir où en est le traitement des informations au fur et à mesure.

Pour ne pas surchargé le fichier, j'ai créé une deuxième feuille "Archives" et je voudrai couper et y coller les informations qui ont été traitées ou qui sont impossibles à traiter.

Pour celà, je voudrai un code couleur. Lorsque les cases "Information traitée" et "Impossible à traiter" sont colorées > toutes la ligne se balance sur l'autre feuille.

J'ai réussi à intégrer ma condition à ma macro, et elle fonctionne lorsque je lui dis de supprimer la ligne. Mais lorsque j'essai de faire le couper/coller plus rien.

Je vous envoi mon tableau et ma macro :

Sub car()

Dim i As Long

For i = 2000 To 1 Step -1

If Worksheets(1).Range("G" & i).Interior.ColorIndex = 6 Then Rows(i).Delete

If Worksheets(1).Range("H" & i).Interior.ColorIndex = 6 Then Rows(i).Delete

Next i

End Sub

Bonjour,

Merci de remplir quelques lignes pour tester. Je propose qu'au lieu de couleur dans les cellules, il faut utiliser par exemple un croix pour transférer la ligne.

Bonjour, cela marchera un peu mieux avec ceci

Sub car()
    Dim i As Long
    With Feuil1
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
            If .Cells(i, 7).Interior.ColorIndex = 6 Or .Cells(i, 8).Interior.ColorIndex = 6 Then
                Feuil2.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 8) = .Cells(i, 1).Resize(, 8).Value
                Rows(i).Delete Shift:=xlUp
            End If
        Next i
    End With
End Sub

Merci de vos réponses!

Wilder, lorsque je met votre code, rien ne se produit dans mon tableau...

Raja, est-il impossible de garder les couleurs? Je pourrais mettre des croix mais je trouve que ce serait plus attractif avec des couleurs. Mon tableau devra servir pour tous les employés et je voudrai quelque chose de présentable. Si tout est gris, je trouve ca monotone.

Re,

Si tu veux garder les couleurs pourquoi pas. Mais essaye de nous joindre ton fichier avec les données pour le test.

Wilder, lorsque je met votre code, rien ne se produit dans mon tableau...

Normal, déplacer le vide de la feuille 1 vers la feuille 2 c'est transparent à l'oeil nu.

Je ne peux pas donner les vraies données, qui sont confidentielles mais j'ai rempli quelques lignes de sorte a ce que ca y ressemble.

[quote="[Wilder]"]

Wilder, lorsque je met votre code, rien ne se produit dans mon tableau...

Normal, déplacer le vide de la feuille 1 vers la feuille 2 c'est transparent à l'oeil nu.[/quote]

J'ai rempli le tableau avant d'y mettre le code et rien ne se produit quand meme

Bref.

J'ai avancé depuis hier. J'ai réussi a faire le transfert de mes données vers la feuille "Archives" mais deux problèmes se posent:

> Je n'arrive pas à transférer toutes les lignes en même temps, je dois cliquer sur le bouton pour chaque ligne

> Je n'arrive pas a envoyer mes données dans la première ligne vide de la feuille archives, ce qui fait qu'a chaque fois que je clique, elles se remplacent.

Voila ma macro :

Sub Archives()

Dim i As Long

For i = 2000 To 3 Step -1

If Worksheets(1).Range("G" & i).Interior.ColorIndex = 6 Or Worksheets(1).Range("H" & i).Interior.ColorIndex = 6 Then

Rows(i).Select

Selection.Cut

Sheets("Archives").Select

ActiveSheet.Rows(i).Select

ActiveSheet.Paste

End If

Next i

End Sub

Pleaaaaaase aidez moi !

Bonjour,

Une proposition à étudier. Pour la décoration, on verra plus tard.

Le bouton RAZ est pour les tests.

Cdlt.

Option Explicit

Public Sub Archiver()
Dim wsData As Worksheet, wsResult As Worksheet
Dim lo As ListObject
Dim lRows As Long, i As Long
Dim lr As ListRow
Dim srcRow As Range

    Application.ScreenUpdating = False

    Set wsData = ActiveSheet
    Set wsResult = Worksheets("Archives")

    With wsData
        Set lo = .ListObjects(1)
        lRows = lo.DataBodyRange.Rows.Count
        For i = lRows To 1 Step -1
            With lo
                If UCase(.DataBodyRange.Cells(i, 7)) = "X" Or UCase(.DataBodyRange.Cells(i, 8)) = "X" Then
                    Set srcRow = .ListRows(i).Range
                    Set lr = wsResult.ListObjects(1).ListRows.Add
                    srcRow.Copy
                    lr.Range.PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    .ListRows(i).Delete
                End If
            End With
        Next i
    End With

    Set lr = Nothing: Set srcRow = Nothing: Set lo = Nothing
    Set wsResult = Nothing: Set wsData = Nothing

End Sub

Merci beaucoup, c'est exactement ce que je recherchais !

Est-il possible de remplacer le "x" par une couleur ou pas du tout ? Juste question de décoration

Re,

Une nouvelle proposition en couleur avec un double clic dans la cellule de ton choix (Colonnes 7 et 8 pour l'exemple).

A tester.

Bon weekend.

Cdlt.

C'est exactement ce que je voulais, merci beaucoup !