XL 2013 RESOLU - MACRO Copier/Coller les cellules d'une ligne en fonction d'un critère

niniylle

XLDnaute Nouveau
Bonjour à tous,

Après avoir épluché plusieurs forums divers, je n'ai pas trouvé la solution à mon problème. Aussi, je viens le poster ici, en espérant que vous puissiez éclairer ma lanterne.

Au sein d'un classeur Excel (2013) , j'ai un onglet "Project" et un onglet "Archive Project".
Dans l'onglet "Project", les données qui m'intéressent commecent toujours à partir de la ligne 12, colonnes C à R, et les colonnes "L" et "Q" sont cachées.
Ce que je souhaite,
Pour chaque ligne de l'onglet "Project" où la colonne R = "No",
Copier les cellules de C à R de cette ligne
Les coller dans l'onglet "Archive Project", dans la 1ère cellule non vide de la colonne C,
Effacer les données la ligne en question de l'onglet "Project" pour les cellules des colonnes C à K + N à O et R

Après plusieurs tentatives, je n'arrive pas à créer la macro qui convient.
J'ai beau tenter avec différentes boucles, je ne parviens pas à obtenir ce que je veux (et je désespère un petit peu ^^").

Pour plus de précisions, les seules valeurs admises dans la colonne "R" sont "Yes", "No", ou "".
Les données de l'onglet Project, démarrent toujours de la cellule C12 jusqu'à R12.

En vous remerciant par avance pour votre aide précieuse,
 

Lone-wolf

XLDnaute Barbatruc
Bonjour nyniylle et bienvenue sur XLD :)

Il faudrait joindre le fichier sans données confidentielles, si tu veux avoir une aide plus rapide.

EDIT: à mettre dans le module de la feuille

VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim plage As Range, plg As Range, pg As Range, x&

    Cancel = True

    Application.ScreenUpdating = False
    x = Range("c" & Rows.Count).End(xlUp).Row

    Set plage = Range("a11:r" & x)  'Ici Entêtes Colonnes
    plage.AutoFilter Field:=18, Criteria1:="No", Operator:=xlAnd

    Set plg = Range("a12:r" & x)
    Set pg = Union(Range("c12:k" & x), Range("n12:o" & x), Range("r12:r" & x))

    plg.Cells.SpecialCells(xlCellTypeVisible).Copy Sheets("Archive Project").Range("c" & Rows.Count).End(xlUp)(2)
    pg.Cells.SpecialCells(xlCellTypeVisible).ClearContents

    plage.AutoFilter
End Sub
 
Dernière édition:

niniylle

XLDnaute Nouveau
Bonjour Lone-Wolf,

Merci :) et merci pour ton aide.
Oui, c'est vrai que j'aurai pu joindre un fichier, j'y penserai la prochaine fois.

Ton code fonctionne :)
De mon côté, la macro est très longue (j'ai fait avec mon niveau en VBA), mais j'ai finalement trouvé ce qui clochait.
Le offset n'était pas pris en compte, j'ai donc remplacé par End(xlUp)(2) et ça fonctionne :)

Merci encore et bonne journée,
 

Lone-wolf

XLDnaute Barbatruc
Bonjour niniylle, le Forum :)

@niniylle : il y a une chose qui m'interpelle et je n'ai pas fait attention hier. Pourquoi ajouter la condition ou "" si tu éfface les cellules dans la feuille Project?? :rolleyes: Comme 3ème condition, moi j'ai mis "Ok".

Une autre façon de faire plus rapide et sans filtrer les colonnes. J'ai fait plusieurs tests et c'est ok chez moi.

VB:
Option Explicit

Sub Copier_Tableau_A_La_Suite()
Dim plage As Range, plg As Range, tbl, tablo()
Dim wb As Worksheet, wm As Worksheet
Dim lig&, col&, fin&, i&, j&, k&, x&

    Set wb = Sheets("Project"): Set wm = Sheets("Archive Project")
    Set plage = wb.Range("c12:r" & wb.Range("c800000").End(xlUp).Row)

    lig = plage.Rows.Count: col = plage.Columns.Count: k = 0
    tbl = plage.Value: ReDim tablo(1 To UBound(tbl), 1 To col)

    For i = LBound(tbl) To UBound(tbl)
        If tbl(i, 16) = "Yes" Or tbl(i, 16) = "No" Or tbl(i, 16) = "Ok" Then
            k = k + 1
            For j = 1 To col
                tablo(k, j) = tbl(i, j)
            Next j
        End If
    Next i
    wm.Range("c" & Rows.Count).End(xlUp)(2).Resize(lig, col) = tablo

    With wb
       fin = .Cells(Rows.Count, 13).End(xlUp).Row
        For x = 12 To fin
            If .Cells(x, 18) = "Yes" Or .Cells(x, 18) = "No" Or .Cells(x, 18) = "Ok" Then
               .Range(.Cells(x, 3), .Cells(x, 11)).ClearContents
               .Range(.Cells(x, 14), .Cells(x, 15)).ClearContents
               .Cells(x, 18).ClearContents
            End If
        Next x
    End With
End Sub
 
Dernière édition:

niniylle

XLDnaute Nouveau
Bonjour Lone Wolf,

Une nouvelle fois merci pour ton aide :)

En fait, il n'y a pas vraiment de ou "". C'était simplement pour préciser que dans cette colonne, soit la cellule est vide, sinon, elle ne peut être renseignée qu'à "Yes", ou "No".

Malheureusement, j'ai besoin de conserver les filtres, car après, je dois ordonner ma plage de données, avec des tris personnalisés.

Passe une bonne après-midi,
 

Kantarus

XLDnaute Nouveau
Bonjour à toutes et à tous, Bonjour Lone-wolf,

Je sais que cette discussion est résolu, mais j'aurai besoin d'avoir un petit coup de pousse sur une même idée que celle traité ici.
J'avais à peut prêt une demande similaire, à savoir copier des informations d'une ligne d'un onglet sur un autre.
Voilà comment je voyais la chose par exemple:
en mettant disons un "X" en colonne L de l'onglet "Details" cela copie certaines données sur l'onglet "Devis"

B de "Details" sur B de "Devis"
C de "Details" sur D de "Devis"...

J'ai essayé de transposé le code, mais sans résultat.

Je joint le fichier pour une meilleur compréhension.

Merci d'avance
 

Pièces jointes

  • DEVIS Test.xlsm
    81.5 KB · Affichages: 59

Kantarus

XLDnaute Nouveau
Re,
J'y avais pensé, mais je ne dois pas recopié toutes les lignes (exemple: lignes "des petites fournitures"et"total matériel" ne sont pas à mettre dans le devis en autre, c'est pour cela que j'avais pensé au "X" en fin de ligne pour que je puisse choisir les ligne à mettre ou non.
 

Discussions similaires

Réponses
22
Affichages
689
Réponses
12
Affichages
217

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth