Copier Coller des lignes en VBA

[Excel123]

Bonjour à tous,

Je suis débutant en langage VBA,

Je n'arrive pas à faire ma macro pour copier coller une ligne vers un second onglet de mon classeur.

Voici ci-joint un fichier exemple avec mes conditions pour copier la ligne vers la feuil2 ou la feuil3



C'est tout bête, mais si quelqu'un pourrait m'aider ça serait vraiment sympa !

 

[Staple1600]

Re : Copier Coller des lignes en VBA

Bonjour à tous

Excel123 (Bienvenue sur le forum)

Il y a 2 condition pour copier en feuil2, colonne B = VRAI et colonne C <> 0

Tu veux dire colonne C pas vide (car il y a des adresses mail dans la colonne C pas des nombres) ?

 

[Excel123]

Re : Copier Coller des lignes en VBA

Oui, désolé c'est différent de vide et non de 0

 

[Staple1600]

Re : Copier Coller des lignes en VBA

Re


Alors essaies cette macro

Sub a()
Dim c As Range
For Each c In Feuil1.Range("B2:B8")
If c And Not IsEmpty(c.Offset(, 1)) Then
Feuil2.Cells(Rows.Count, 1).End(3)(2).Resize(, 4).Value = c.Resize(, 4).Value
Else
Feuil3.Cells(Rows.Count, 1).End(3)(2).Resize(, 4).Value = c.Resize(, 4).Value
End If
Next
End Sub

 

[Excel123]

Re : Copier Coller des lignes en VBA

super merci par contre j'ai essayé d'automatisé le nombre de lignes et de colonnes
Mais j'ai perdu le prénom en chemin 😕

Sub a()

Dim c As Range
Dim x, y

x = Worksheets("Feuil1").Range("A1").End(xlToRight).Column
y = Worksheets("Feuil1").Range("A1").End(xlDown).Row

For Each c In Feuil1.Range("B2:B" & y & "")

If c And Not IsEmpty(c.Offset(, 1)) Then
Feuil2.Cells(Rows.Count, 1).End(3)(2).Resize(, x).Value = c.Resize(, x).Value
Else
Feuil3.Cells(Rows.Count, 1).End(3)(2).Resize(, x).Value = c.Resize(, x).Value
End If
Next
End Sub

 

[camarchepas]

Re : Copier Coller des lignes en VBA

Bonjour Excel , Staple,

Bon une autre façon d'écrire , puisque j'ai écrit , je poste .

Sub Transfert()
Dim Ligne As Long
Dim LigneActuelle As Long
Dim Info As Variant
For Ligne = 2 To 10
  If Worksheets("Feuil1").Range("A" & Ligne) <> "" Then
   If Worksheets("Feuil1").Range("B" & Ligne) = "Vrai" And Worksheets("Feuil1").Range("C" & Ligne).Text <> "" Then
    'Si conditions ok alors
      LigneActuelle = Worksheets("Feuil2").Range("A20000").End(xlUp).Row + 1
      Info = Worksheets("Feuil1").Range("A" & Ligne & ":C" & Ligne)
      Worksheets("Feuil2").Range("A" & LigneActuelle & ":C" & LigneActuelle) = Info
     Else
    'Sinon
      LigneActuelle = Worksheets("Feuil3").Range("A20000").End(xlUp).Row + 1
      Info = Worksheets("Feuil1").Range("A" & Ligne & ":C" & Ligne)
      Worksheets("Feuil3").Range("A" & LigneActuelle & ":C" & LigneActuelle) = Info
   End If
  End If
 Next Ligne
End Sub

Cordialement

 

[Staple1600]

Re : Copier Coller des lignes en VBA

Re, Bonjour camarchepas

Pour retrouver les prénoms, et pour avoir le bon x 😉

Sub ab()
Dim c As Range
Dim x&, y&
With Worksheets("Feuil1")
    x = .Cells(1, Columns.Count).End(xlToLeft).Column
    y = .Cells(Rows.Count, 1).End(3).Row
    For Each c In .Range("B2:B" & y & "")
    If c And Not IsEmpty(c.Offset(, 1)) Then
    Feuil2.Cells(Rows.Count, 1).End(3)(2).Resize(, x).Value = c.Offset(, -1).Resize(, x).Value
    Else
    Feuil3.Cells(Rows.Count, 1).End(3)(2).Resize(, x).Value = c.Offset(, -1).Resize(, x).Value
    End If
    Next
End With
End Sub

 

[Excel123]

Re : Copier Coller des lignes en VBA

Merci pour vos réponses ! C'est Top !