Sub CollerSurVisible()
Dim rgSel As Range, rgDes As Range
Dim i As Long, CopieFaite As Boolean
On Error GoTo Error_001
Set rgSel = Nothing
Set rgSel = Application.InputBox("Sélectionner les cellules à copier:", _
Type:=8)
If rgSel Is Nothing Then GoTo Error_001
If rgSel.Areas.Count <> 1 Then GoTo Error_001
On Error Resume Next
On Error GoTo Error_002
Set rgDes = Nothing
Set rgDes = Application.InputBox("Sélectionner la cellule (gauche haut) où coller les données:", _
Type:=8)(1, 1)
If rgDes Is Nothing Then GoTo Error_002
On Error GoTo Error_003
For i = 1 To rgSel.Rows.Count
Do
CopieFaite = False
If rgDes.EntireRow.Hidden Then
Set rgDes = rgDes.Offset(1)
Else
rgSel.Rows(i).Copy
'Remplacer xlPasteAll par ce que vous souhaitez copier
'xlpasteAllAll -4104 Tout sera collé.
'xlpasteAllAllExceptBorders 7 Tout sera collé à l'exception des bordures.
'xlpasteAllAllMergingConditionalFormats 14 Tout sera collé et les formats conditionnels seront fusionnés.
'xlpasteAllAllUsingSourceTheme 13 Tout sera collé sur la base du thème source.
'xlpasteAllColumnWidths 8 La largeur de colonne copiée est collée.
'xlpasteAllComments -4144 Les commentaires sont collés.
'xlpasteAllFormats -4122 Le format source copié est collé.
'xlpasteAllFormulas -4123 Les formules sont collées.
'xlpasteAllFormulasAndNumberFormats 11 Les formules et les formats numériques sont collés.
'xlpasteAllValidation 6 Les validations sont collées.
'xlpasteAllValues -4163 Les valeurs sont collées.
'xlpasteAllValuesAndNumberFormats
rgDes.PasteSpecial xlPasteAll
CopieFaite = True
Set rgDes = rgDes.Offset(1)
End If
Loop Until CopieFaite
Next i
Exit Sub
Error_001:
MsgBox "Sélection non valide => Sortie"
Exit Sub
Error_002:
MsgBox "Destination non valide => Sortie"
Exit Sub
Error_003:
MsgBox "Erreur Coller => Sortie"
Exit Sub
End Sub