1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
| Sub CopieVersC()
'
Dim DerLigneA As Long, DerLigneB As Long, DerLigneC As Long, i As Long
DerLigneA = Sheets("A").Cells(Columns(1).Rows.Count, 1).End(xlUp).Row 'Defini la dernière ligne
DerLigneB = Sheets("B").Cells(Columns(1).Rows.Count, 1).End(xlUp).Row 'Defini la dernière ligne
DerLigneC = 2 'Défini la valeur pour le collage
Sheets("A").Range("A1:D1").Copy Destination:=Sheets("C").Range("a1") 'Copie la ligne des titres
Sheets("A").Activate 'Active la feuille A, nécessaire pour le copié
For i = 2 To DerLigneA 'Fait une boucle de 2 à la dernière ligne; 2 car titre
If Sheets("A").Cells(i, 1).Value <> 0 Then 'vérifie si la valeur = 0 sur base de la colonne A
Sheets("A").Range(Cells(i, 1), Cells(i, 4)).Copy Destination:=Sheets("C").Cells(DerLigneC, 1) 'si non copie vers feuilleC
DerLigneC = DerLigneC + 1 'Incrémente la ligne de destination de la feuilleC
End If
Next i
'Idem pour la feuilleB
Sheets("B").Activate
For i = 2 To DerLigneB
If Sheets("B").Cells(i, 1) <> 0 Then
Sheets("B").Range(Cells(i, 1), Cells(i, 4)).Copy Destination:=Sheets("C").Cells(DerLigneC, 1)
DerLigneC = DerLigneC + 1
End If
Next i
End Sub |
Partager