Option Explicit
Sub copie()
Dim f As Worksheet, f1 As Worksheet, i As Byte, j As Byte
Set f = Sheets("Feuil1")
Set f1 = Sheets("Feuil2")
j = f1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
For i = 8 To f.Cells(Rows.Count, 3).End(xlUp)
If f.Cells(i, 3) <> "" Then
f1.Cells(j, 2) = f.Cells(i, 2)
f1.Cells(j, 3) = f.Cells(i, 3)
f1.Cells(j, 4) = f.Cells(i, 4)
f1.Cells(j, 5) = f.Cells(i, 5)
j = j + 1
End If
Next i
End Sub
BonjourBonjour,
Voici, si j'ai bien tout compris, car il est assez difficile de faire moins clair comme demande...
VB:Option Explicit Sub copie() Dim f As Worksheet, f1 As Worksheet, i As Byte, j As Byte Set f = Sheets("Feuil1") Set f1 = Sheets("Feuil2") j = f1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row For i = 8 To f.Cells(Rows.Count, 3).End(xlUp) If f.Cells(i, 3) <> "" Then f1.Cells(j, 2) = f.Cells(i, 2) f1.Cells(j, 3) = f.Cells(i, 3) f1.Cells(j, 4) = f.Cells(i, 4) f1.Cells(j, 5) = f.Cells(i, 5) j = j + 1 End If Next i End Sub
A+
Sub Efface()
Range("C8:E" & Range("C" & Rows.Count).End(xlUp).Row).ClearContents
End Sub
Sub copie()
Dim f As Worksheet, f1 As Worksheet, i As Byte, j As Byte
Set f = Sheets("Feuil1")
Set f1 = Sheets("Feuil2")
j = f1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
For i = 8 To f.Cells(Rows.Count, 3).End(xlUp).Row
If f.Cells(i, 3) <> "" Then
f1.Cells(j, 2).Resize(, 4).Value = f.Cells(i, 2).Resize(, 4).Value
j = j + 1
End If
Next i
End Sub
Sub Macro1()
Dim critR As Range, DestR As Range
Set critR = Sheets("Feuil1").[K6:K7]: Set DestR = Sheets("Feuil2").[B2:E2]
Sheets("Feuil1").[B6:E18].AdvancedFilter xlFilterCopy, critR, DestR, False
End Sub
ah oui je l'ai fais merci beaucopRe,
Faut il te faire un clearcontents automatique également ?
merci beaucoup votre code également fort,c'est bien et pratiquant.Re
Calvus.
On peut toujours modifier le code avec le Filtre en conséquence