XL 2016 VBA - Conserver la mise en forme lors d'une extraction

AxelViens

XLDnaute Nouveau
Bonjour,

J'ai ce code qui me permet d'extraire dans un nouvel onglet l'ensemble des lignes dont la variable (ciblée via une cellule) est présente dans la colonne A.

Cependant je souhaiterai garder la mise en forme (couleur , police, alignement et lien hypertexte..), avez vous une idée de comment faire ?

Bien à vous,



Code:
Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Dim DerligSrc&, DerligDst&
DerligSrc = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Feuil3")
    For i = 5 To DerligSrc
        If .[A1].Value = Worksheets("Feuil1").Range("A" & i) Then
            DerligDst = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("E" & DerligDst & ":K" & DerligDst) = Worksheets("Feuil1").Range("A" & i & ":G" & i).Value
        End If
    Next i
End With

End Sub
 
Solution
Bonjour @AxelViens , @cp4, @Bernard_XLD

Ma proposition

VB:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim DerligSrc&, DerligDst&
DerligSrc = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Feuil3")
    For i = 5 To DerligSrc
        If .[A1].Value = Worksheets("Feuil1").Range("A" & i) Then
            DerligDst = .Range("A" & Rows.Count).End(xlUp).Row + 1
            '.Range("E" & DerligDst & ":K" & DerligDst) = Worksheets("Feuil1").Range("A" & i & ":G" & i).Value
            Worksheets("Feuil1").Range("A" & i & ":G" & i).Copy Destination:=Sheets("feuil3").Range("E" & DerligDst)
        End If
    Next i
End With
End Sub

*Merci de ton retour

@Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour @AxelViens , @cp4, @Bernard_XLD

Ma proposition

VB:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim DerligSrc&, DerligDst&
DerligSrc = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Feuil3")
    For i = 5 To DerligSrc
        If .[A1].Value = Worksheets("Feuil1").Range("A" & i) Then
            DerligDst = .Range("A" & Rows.Count).End(xlUp).Row + 1
            '.Range("E" & DerligDst & ":K" & DerligDst) = Worksheets("Feuil1").Range("A" & i & ":G" & i).Value
            Worksheets("Feuil1").Range("A" & i & ":G" & i).Copy Destination:=Sheets("feuil3").Range("E" & DerligDst)
        End If
    Next i
End With
End Sub

*Merci de ton retour

@Phil69970
 

AxelViens

XLDnaute Nouveau
Bonjour @cp4 @Bernard_XLD et @Phil69970

Avec la première ligne --> Erreur d'exécution
Sans le .Value --> Me coupe la zone sélectionné (comme un couper/coller) mais sans la coller sur l'autre feuille.

Et la dernière solution .. TOP ! Fonctionne correctement.. la couleur , la police , la synthaxe, le fond tout est OK ! @Phil69970 :) (Je fais le test avec lien hypertexte dans la matinée, si je ne reviens pas sur ce sujet là, c'est que sa fonctionne aussi)

Merci à tout les trois,

Bonne journée
 

Statistiques des forums

Discussions
311 720
Messages
2 081 900
Membres
101 834
dernier inscrit
Jeremy06510