Exporter certaines cellules vers autre feuille + condition

Bonjour à tous,

Je passe ma vie par ici en ce moment . Aujourd'hui, je fais face à un nouveau problème.

Dans ma feuille numéro 1 qu'on appelera FEUILLE1, j'ai des affaires sous formes de lignes et lorsque le devis d'une affaire est signé (Colonne G : liste déroulanteVDD : OUI/NON) j'aimerais qu'il copie certaine cellules de la ligne de cette affaire vers un nouveau tableau (déja fait), de la feuille numéro 2, qu'on appelera FEUILLE2, donc sous condition du OUI.

Donc en 2 partie : La Condition, et le copié-collé.

Pour la 2ème partie j'avais envisagé ce code trouvé sur la toile :

Sub Recopie()

Dim Source As String
Dim Cible As String
Dim LigneEncours As Long
'Chargement du nom des feuilles origine et destination
 Cible = "FEUILLE2"
Source = "FEUILLE1"
'Calcul de la ligne courante
LigneEncours = Worksheets(Source).Range("B" & Rows.Count).End(xlUp).Row + 1
'Copie des valeurs
With Worksheets(Cible)
 .Range("B" & LigneEncours) = Worksheets(Source).Range("B3").Value
 .Range("C" & LigneEncours) = Worksheets(Source).Range("C3").Value
 .Range("F" & LigneEncours) = Worksheets(Source).Range("D3").Value
 .Range("H" & LigneEncours) = Worksheets(Source).Range("F3").Value
 .Range("I" & LigneEncours) = Worksheets(Source).Range("I3").Value
 .Range("J" & LigneEncours) = Worksheets(Source).Range("J3").Value
 .Range("K" & LigneEncours) = Worksheets(Source).Range("K3").Value
 .Range("L" & LigneEncours) = Worksheets(Source).Range("L3").Value
 .Range("M" & LigneEncours) = Worksheets(Source).Range("M3").Value
 .Range("N" & LigneEncours) = Worksheets(Source).Range("N3").Value
 .Range("O" & LigneEncours) = Worksheets(Source).Range("O3").Value

End With
End Sub

Mais cela ne fonctionne pas. J'aurais besoin d'un petit coup de main.

Je vais tenter de vous joindre au plus vite un fichier Exemple pour faciliter la comprehension

Je vous remercie par avance.

Bonjour,

Essaie plutôt ceci :

With Worksheets(Cible)
Worksheets(Source).Range("B3").copy .Range("B" & LigneEncours)
.....

Maintenant à la lecture de ton code j'ai plutôt l'impression que cette ligne devrait être

LigneEncours = Worksheets(Cible).Range("B" & Rows.Count).End(xlUp).Row + 1

au lieu de

LigneEncours = Worksheets(Source).Range("B" & Rows.Count).End(xlUp).Row + 1

Si ok, clique sur le V vert à coté du bouton EDITER lors de ta réponse pour cloture le fil

Amicalement

Bonjour Dan,

Merci pour ta réponse en effet, les corrections apportées permettent de faire fonctionner la macro.

En revanche,

- J'ai un tableau et la macro transfert la ligne à la fin du tableau, c'est à dire à la 10 000ème ligne, serait possible d'envoyer cela ligne 3, dans le tableau (qui est vide à mes yeux) au lieu de la 10 000ème ligne.

- Dans mon cas, j'avais 3 lignes dans le tableau "source", seulement la première a été transféré. Est ce possible de transferer toutes les lignes écrite de ce tableau, sous la condition que la colonne G contienne le mot "OUI" ?

Petit rappel du code corrigé par Dan :

Sub Recopie()

Dim Source As String
Dim Cible As String
Dim LigneEncours As Long
'Chargement du nom des feuilles origine et destination
Cible = "Prevision Devis Envoyé1"
Source = "Prevision Affaire"
'Calcul de la ligne courante
LigneEncours = Worksheets(Cible).Range("B" & Rows.Count).End(xlUp).Row + 1
'Copie des valeurs
With Worksheets(Cible)

Worksheets(Source).Range("B3").Copy .Range("B" & LigneEncours)
Worksheets(Source).Range("C3").Copy .Range("C" & LigneEncours)
Worksheets(Source).Range("D3").Copy .Range("F" & LigneEncours)
Worksheets(Source).Range("F3").Copy .Range("H" & LigneEncours)
Worksheets(Source).Range("I3").Copy .Range("I" & LigneEncours)
Worksheets(Source).Range("J3").Copy .Range("J" & LigneEncours)
Worksheets(Source).Range("K3").Copy .Range("K" & LigneEncours)
Worksheets(Source).Range("L3").Copy .Range("L" & LigneEncours)
Worksheets(Source).Range("M3").Copy .Range("M" & LigneEncours)
Worksheets(Source).Range("N3").Copy .Range("N" & LigneEncours)
Worksheets(Source).Range("O3").Copy .Range("O" & LigneEncours)

End With
End Sub

Merci beaucoup de vos efforts en tout cas!

Bonne journée à tous !

Re-bonjour,

Voici un fichier exemple pour faciliter la comprehension de ma demande.

Merci d'avance

Bonjour

J'ai un fichier mais je ne sais pas faire des macro

c'est pour j'ai besoin de votre aide