XL 2019 copier une ligne (n'est pas ligne entiere ) sous condition

oudvoud

XLDnaute Nouveau
Bonjour les gens
je cherche a ce que excel me copie une ligne sous condition que la cellule en Colonne B soit égale a une valeur
j'ai fait ce code
en fait je veux pas copier toute la ligne mais juste j'usqu'a la colonne D
je suis debutant en code

Private Sub CommandButton1_Click()
A = Worksheets("feuil1").Cells(Rows.Count, 1).End("D").Row
For i = 1 To A
If Worksheets("feuil1").Cells(i, 2).Value = "C1" Then
Worksheets("feuil1").Rows(i,).Copy
Worksheets("feuil2").Activate
B = Worksheets("feuil2").Cells(Rows.Count, 1).End("D").Row
Worksheets("feuil2").Cells(B + 1, 1).Select

ActiveSheet.Paste
Worksheets("feuil1").Activate

End If
Next
Application.CutCopyMode = False

ThisWorkbook.Worksheets("feuil1").Cells(1, 1).Select

End Sub
 

Ikito

XLDnaute Occasionnel
Bonjour oudvoud,

Au lieu de :
VB:
Worksheets("feuil1").Rows(i,).Copy
Ecrire :
Code:
Worksheets("feuil1").Range("A" & i & ":" & "D" & i).Copy
 

Roblochon

XLDnaute Impliqué
Bonjour,

Si j'ai bien compris essayez ceci:
VB:
Private Sub CommandButton1_Click()
    Dim A As Long, B As Long, i As Long
    With Worksheets("Feuil1")
        A = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 1 To A
            If .Cells(i, 2).Value = "C1" Then
                .Cells(i, 1).Resize(, 4).Copy Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4)
            End If
        Next
    End With
    Application.CutCopyMode = False
End Sub
Sinon il vous faudra vous fendre d'un classeur exemple.

Cordialement

Edit: bonjour @Ikito
 

Roblochon

XLDnaute Impliqué
Re Bonjour,

Votre classeur n'a même pas de macro. D'autant moins une tentative d'adaptation du travail que nous vous avons donné. Si vous vouliez que nous le fassions à votre place, il fallait le dire de suite et cela aurait été sans moi.

A+
 

Discussions similaires


Haut Bas