Copier ligne sous condition d'un document vers un autre document

Salut à tous

J'ai besoin d'aide et je sais que pour vous, les pros d'Excel, ma demande sera super simple

Explication : J'ai un document destination que j'ouvre et, depuis ce document, j'exécute une macro qui va ouvrir le document source et me copier toutes les lignes de mon tableau. Voici ma macro super basique, faite en utilisant l'option *enregistrer une macro*, pas terrible me direz-vous, cependant, elle fonctionne parfaitement mais je ne souhaite pas les lignes vides de mon tableau, seulement celles avec un 1 dans la colonne B. Ligne à copier à partir de C3 jusqu'à F.

Sub importer()
Dim chemin As String, fichier As String
Application.DisplayAlerts = False

chemin = ThisWorkbook.Path
fichier = chemin & "\" & "Source.xlsm"
Sheets("Modèle").Select
Sheets("Modèle").Copy After:=Sheets("Modèle")
Range("A2").Select
Workbooks.Open Filename:=fichier
ActiveSheet.Unprotect Password:="123"
Range("C3:F22").Select
Selection.Copy
Windows("Destination.xlsm").Activate ActiveSheet.Paste
Windows("Source.xlsm").Activate
ActiveWindow.Close SaveChanges:=False
Application.CutCopyMode = False
Application.DisplayAlerts = True
End Sub

Ce code est vraiment indigeste, j'ai tenté de définir le classeur source CS, l'onglet source OS etc... etc... et malgré des heures de recherches et de tests, je n'y arrive pas

A savoir : Le bouton de ma macro se trouve sur le fichier destination, ma macro copie le modèle du dossier, en fait une copie, il ouvre mon document source, déverrouille le mot de passe "123", étant donné que le doc n'a que des listes déroulante, je fais le tri sur la colonne B qui m'affiche des 1 si F est complété sinon des 0. J'aimerais que la macro ne copie pas bêtement la vingtaine de ligne de mon tableau, je souhaite qu'il traite uniquement les lignes où B contient 1, qu'il sélectionne les colonnes C à F, qu'il les copie et qu'il referme le classeur source sans enregistrer aucune modification. Ensuite, il reprend le classeur destination et colle le tout sur mon nouvel onglet à la ligne A2.

Je vous joints les 2 documents au besoin pour faire des tests, les 2 docs sont enregistrés dans le même répertoire....

Je vous remercie déjà de tout mon cœur pour l'aide que vous allez m'apporter
Excellente soirée à tous et au plaisir de vous lire

Bonjour,

Essai plutôt ce code !

Sub importer()
Dim Wb As Workbook
Dim CeWb As Workbook
Dim WbDonnées As Workbook

Dim WsDonnées As Worksheet
Dim CetteWs As Worksheet

Set CeWb = ActiveWorkbook

Dim Chemin, Fichier As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Chemin = ThisWorkbook.Path & "\"
Fichier = "Formation_continue.xlsm"
Workbooks.Open Filename:=Chemin & Fichier

Application.Wait (Now + TimeValue("00:00:02"))
Set WbDonnées = Workbooks(Fichier)

Set CetteWs = CeWb.Worksheets("Modèle")
Set WsDonnées = WbDonnées.Worksheets("Inscriptions")

j = 2

For i = 3 To WsDonnées.Range("B65535").End(xlUp).Row
    If WsDonnées.Cells(i, "B") = 1 Then
        WsDonnées.Cells(i, "C").Copy
        CetteWs.Cells(j, "A").PasteSpecial
        WsDonnées.Range("D" & i & ":" & "H" & i).Copy
        CetteWs.Range("B" & j & ":" & "F" & j).PasteSpecial
        j = j + 1
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

WbDonnées.Close
Application.CutCopyMode = False

End Sub

Bonne journée

Oh Moul

T'es un as merci infiniment!!! En plus j'ai vu que tu avais directement mis le code qui correspond réellement au nom de mes fichiers, t'assures

J'ai un souci avec la colonne des noms : les lignes impaires aucun problème, ce sont des listes déroulante alors le nom se colle correctement... En revanche, les lignes paires ont une formule qui dépend des lignes paires à savoir pour C4 par exemple :=SI(C3="";"";C3)
Le problème est dans ma feuille de destination, si je trie par date de formation, toutes les lignes vont se mélanger et du coup, les noms ne correspondront plus à la réalité à cause de cette maudite formule

Tu arrives encore à me solutionner ce problème?

Je gère beaucoup moins les formules non VBA...

Je vais regarde quand même

Je te tiens au courant rapidement !

EDIT : Peux tu clarifier un peu mieux... Lors de la copie j'ai pas de soucis avec ça. Les noms et formule sont bien copié.

Exemple :

J'ai tenté avec ça mais ça ne fonctionne pas... je pense qu'il y a une option VBA mais laquelle

For i = 3 To WsDonnées.Range("B65535").End(xlUp).Row If WsDonnées.Cells(i, "B") = 1 Then WsDonnées.Cells(i, "C").Copy CetteWs.Cells(j, "A").PasteSpecial WsDonnées.Range("D" & i & ":" & "H" & i).Copy CetteWs.Range("B" & j & ":" & "F" & j).PasteSpecial xlPasteValues

Je sais pas si tu as les notifs de modification de messages...

Regarde mon message au dessus ..

Coucou Moul,
Sorry pour la durée de ma réponse mais je n'étais pas au bureau, me voilà de retour
Alors.... si je ne traite pas les données, aucun problème comme tu me l'as montré dans ta capture d'écran

En revanche, si je décide de trier les dates, là, ça ne joue plus

Je vais tenter d'enregistrer les manip et de voir ce qui me sort comme code au moment où je fais le collage spécial valeurs.... j'te redis dans 2'

Tout fonctionne nickel!! Encore merci tout plein pour ton aide