copier cellules vers une autre feuille

[recovery]

Bonjour,

Je reviens vers vous car mon problème persiste depuis plusieurs jours de plus mes connaissances en vba sont trop modestes pour taper le code adéquate voici ce que je souhaiterais faire.
Dans ma base de données pour toutes les feuilles, je me positionne sur la cellule ao3, à partir de cette dernière je voudrais tester certaines cellule situées sur la même ligne exemple ao3, as3, aw3, ba3, be3, bi 3, si l’une d’entre elles contient une donnée copier celle-ci avec ses références commerçant toujours situés sur la même ligne dans le cas présent les cellules a3,b3,c3,d3, vers le feuille Ref, ensuite la cellule ao4 dans les mêmes conditions jusqu'à la dernière ligne de ma base de données.
Je joins un fichier exemple et merci si quelqu’un arrive à me dépanner

 

[Robert]

Re : copier cellules vers une autre feuille

Bonjour Recovery, bonjour le forum,

Peut-être comme ça :

Sub Macro2()
Dim s As Object 'déclare la variable s (onglet Source)
Dim d As Object 'déclare la variable d (onglet Destination)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim li As Range 'déclare la variable li (LIgnes)
Dim col As Byte 'déclare la variable col (COLonne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Set s = Sheets("GAMBETTA") 'définit l'onglet source s
Set d = Sheets("Ref") 'définit l'onglet destination d
dl = s.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = s.Range("AO3:BI" & dl) 'définit la plage pl
For Each li In pl.Rows 'boucle 1 : sur toutes les lignes li de la plage pl
    For col = 41 To 61 Step 4 'boucle 2 : sur les colonnes 41 à 61 par pas de 4
        If s.Cells(li.Row, col).Value <> "" Then 'condition : si la colonne n'est pas vide
            'définit la cellule de destination dest
            Set dest = IIf(d.Range("A1").Value = "", d.Range("A1"), d.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
            s.Range(s.Cells(li.Row, 1), s.Cells(li.Row, 4)).Copy 'copie les références commerçant
            dest.PasteSpecial (xlPasteValues) 'colle la valeur des références commerçant
            s.Cells(li.Row, col).Copy 'copie la cellule
            dest.Offset(0, 4).PasteSpecial (xlPasteValues) 'colle la valeur de la cellule
        End If 'fin de la condition
    Next col 'nouvelle colonne de la boucle 2
Next li 'nouvelle ligne de la boujcle 1
End Sub

 

[recovery]

Re : copier cellules vers une autre feuille

Un grand Merci robert d'avoir répondu aussi vite,

Ton code fonctionne parfaitement, toutefois les cellules testées le sont uniquement dans la colonne ao les autres as, aw, ba, be, bi,ne le sont pas, est il possible de modifier le code en ce sens.

Encore merci

Cordialement.

 

[Robert]

Re : copier cellules vers une autre feuille

Bonjour le fil, bonjour le forum,

Si, si, le code teste bien toutes les cellules mentionnées mais ne s'exécute que si la cellule n'est pas vide.
Ton fichier modifié en pièce jointe. Lance la macro et tu verras...

 

[recovery]

Re : copier cellules vers une autre feuille

Merci Robert
effectivement ton code fonctionne à merveille, tu viens de me sortir une belle épine du pied
Encore merci et chapeau pour l'état d'esprit de ce forum