Transfert de données un peu spéciale ...

[karinette]

Bonjour @ tous,
Voila mon problème, j'essaye de transferer des données d'une plage de cellule (B6:J31) en automatique sur une page differente, à partir de la dernière ligne vide.
J'ai tenté quelques macros, mais sans succès ... 🙁
L'idée étant de copier les données, mais uniquement des lignes non vides ....
Pas très clair, mais avec l'exemple, cela devrait permettre à un expert excel de m'aider ...
Merci ...

 

[gwenlorin]

Re : Transfert de données un peu spéciale ...

Bonjour,

quelques précisions sur ta demande :
- est ce que la plage de cellule (B6:J31) pourra bouger en taille, cellule de départ, ... ?
- La macro devra coller les données sans chercher à savoir si elles ont déjà était insérer au préalable -> gestion des doublons ?

 

[karinette]

Re : Transfert de données un peu spéciale ...

- est ce que la plage de cellule (B6:J31) pourra bouger en taille, cellule de départ, ... ?

Non, la plage est fixe ...

- La macro devra coller les données sans chercher à savoir si elles ont déjà était insérer au préalable -> gestion des doublons ?

Pour les doublons, on doit pouvoir les mettre ... Il peut y avoir plusieur fois le même mots ...

 

[Robert]

Re : Transfert de données un peu spéciale ...

Bonjour Karinette, Gwenlorin, bonjour le forum,

je te propose la macro suivante (qui ne gère pas les doublons) :

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
 
With Sheets("INDEX") 'prend en compte l'onglet "INDEX"
    For Each cel In .Range("B6:B" & .Range("B65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne B
        If cel.Value <> "" Then 'condition : si la cellule n'est pas vide
            Set dest = Sheets("BASE").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(cel, cel.Offset(0, 8)).Copy dest 'copie et colle
        End If 'fin de la condition
    Next cel 'prochaine cellule de la boucle
End With 'fin de la prise en compte de l'onglet "INDEX"
End Sub

 

[gwenlorin]

Re : Transfert de données un peu spéciale ...

Re,

La procédure ci-dessous devait le faire :

Sub transfert()
Dim lastrow As Long

Application.ScreenUpdating = False


For i = 6 To 31 '--- parcours de toutes les lignes
    Sheets("INDEX").Activate '---sélection de la feuille INDEX
   If ActiveSheet.Cells(i, 2).Value <> "" Then '--- test si ligne vide
        ActiveSheet.Range(Cells(i, 2), Cells(i, 10)).Copy
        Sheets("BASE").Activate
        On Error Resume Next
        lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row '---détection dernière ligne occupée sur BASE
        ActiveSheet.Cells(lastrow + 1, 1).Select
        ActiveSheet.Paste
    End If
Next i

Application.ScreenUpdating = True
End Sub

Bonjour Robert, nos messages se sont croisés
Karinette, le code de Robert semble plus "compact" et plus souple que le mien

 

[karinette]

Re : Transfert de données un peu spéciale ...

🙂
Merci beaucoup ....
Les 2 macros fonctionnent à merveille ...
Rapide et efficace, comme toujours ....