Copier / Coller depuis un Feuillet vers un autre si condition Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
p
picsou
Nouveau venu
Nouveau venu
Messages : 5
Inscrit le : 16 décembre 2018
Version d'Excel : Excel 2013 EN

Message par picsou » 16 décembre 2018, 23:02

Bonsoir à tous,

Je travaille sur ce script au bureau afin qu'à terme, je puisse générer des organigrammes à partir d'extractions du personnel.
(pour la petite histoire, je pouvais le faire via Visio, mais je n'avais pas la possibilité de synchroniser avec une base de donnée, et il me fallait de toute manière faire du traitement en amont, c'est pourquoi j'essaye de créer ces organigrammes "à la volée")

Pour ce faire, je colle mon extraction dans un onglet, elle est traitée dans un onglet "DB" (division par départements, etc)
et mon objectif est ensuite de coller 4 colonnes de ce traitement (Nom, poste, emplacement, manager...) dans un autre onglet, "Destination", qui servira de base à la création des organigrammes.
J'avais essayé dans un premier temps de ne copier que les cellules non-vides ou de supprimer la ligne dans le cas contraire, mais il arrivait qu'une des 4 colonnes soit vide, ce qui me faisait perdre toutes les infos du salarié.
J'ai donc préféré mettre un 0 sur les lignes à ne pas retenir et à filtrer en fonction.

Je n'y arrive malheureusement pas; j'ai beau tenter de modifier tel ou tel passage, c'est manifestement au dessus de mes compétences...

je sais que le traitement initial est un peu lourd avec les différents onglets; mais c'est précisément parce que je suis néophyte que j'ai préféré dans un premier temps séparer le tout en sous-projets, j'espère ensuite fusionner puis optimiser le tout.

Pourriez-vous m'aider s'il vous plait?

Je vous remercie :)
Sub sortdatabase()

Dim Destination As String

Dim finalrow As Integer

Dim i As Integer 'row counter

Sheets("Destination").Range("A2:D1000").ClearContents 'me permet de nettoyer la page avant de recoller les infos'

Destination = Sheets("Destination").Range("A2").Value

finalrow = Sheets("DB").Range("A1000").End(xlUp).row

For i = 2 To finalrow

        With Sheets("DB")

       If IsText(.Range(.Cells(i, 1), .Cells(i, 4))) Then 'ne retenir que les lignes ne comportant pas de 0'

       .Range(.Cells(i, 1), .Cells(i, 4)).Copy
  
        Sheets("Destination").Range("A2:D1000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

        End If

End With

Next

End Sub
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 6'030
Appréciations reçues : 351
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 17 décembre 2018, 05:47

Bonjour,
:bv:

à tester,
Sub Transfert_ligne_sans_0()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim finalrow1 As Long, finalrow2 As Long, i As Long

Set sh1 = Sheets("DB")
Set sh2 = Sheets("Destination")

sh2.Range("A2:D1000000").ClearContents 'me permet de nettoyer la page avant de recoller les infos'

finalrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row  'derniere ligne de la feuille "DB"

For i = 2 To finalrow1
  If Application.CountIf(sh1.Range(Cells(i, 1).Address, Cells(i, 4).Address), 0) = 0 Then 'ne retenir que les lignes ne comportant pas de 0'
    finalrow2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 'derniere ligne de la feuille "Destination" + 1
    sh2.Range(Cells(finalrow2, 1).Address, Cells(finalrow2, 4).Address) = sh1.Range(Cells(i, 1).Address, Cells(i, 4).Address).Value
  End If
Next
End Sub
Prenons soins de nous et de notre vaisseau spatial, nous n’en n’avons qu’un ...notre planète terre
isabelle
p
picsou
Nouveau venu
Nouveau venu
Messages : 5
Inscrit le : 16 décembre 2018
Version d'Excel : Excel 2013 EN

Message par picsou » 18 décembre 2018, 10:07

Bonjour,

Merci beaucoup tout, cela fonctionne 😁
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message