Sub tester()
Dim j As Long, DerLg As Long, i As Long, reponseD As Long, reponseA As Long, k As Long
Application.ScreenUpdating = False
With Sheets("base")
reponseD = InputBox("Veuillez indiquer la colonne de départ à copier (exemple:6)")
reponseA = InputBox("Veuillez indiquer la colonne d'arrivée à copier (exemple:10)")
For j = 2 To [D1]
If .Cells(j, 1) = 0 And .Cells(j, 6) <> "" Then
For k = reponseD To reponseA
If k = reponseD Then
DerLg = .Range("C" & .Rows.Count).End(xlUp).Row + 1
.Range("C" & DerLg) = .Cells(j, k)
.Range("C" & DerLg).Select
Else
ActiveCell = ActiveCell & .Cells(j, k)
End If
Next k
ElseIf .Cells(j, 6) = "" Then
Exit For
End If
Next j
For i = 2 To [D1] + 1
.Cells(i, 3).Font.Bold = True
Next i
End With
Call couleurs
Application.ScreenUpdating = True
End Sub