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

AxelViens · 29 Mars 2022

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

Phil69970 · 29 Mars 2022

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

cp4 · 29 Mars 2022

Bonsoir,

Sans fichier difficile de t'aider. Essaie avec Copy comme ci-dessous

VB:

.Range("E" & DerligDst & ":K" & DerligDst).Copy Worksheets("Feuil1").Range("A" & i & ":G" & i).Value

Bonne soirée.

Bernard_XLD · 29 Mars 2022

Bonjour AxelViens, cp4, le forum

cp4 à dit:
Bonsoir,

Sans fichier difficile de t'aider. Essaie avec Copy comme ci-dessous

VB:

.Range("E" & DerligDst & ":K" & DerligDst).Copy Worksheets("Feuil1").Range("A" & i & ":G" & i).Value

Bonne soirée.

@cp4 , à mon humble avis, le .Value en destination est de trop !

Cordialement, @+

Phil69970 · 29 Mars 2022

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 · 30 Mars 2022

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

cp4 · 30 Mars 2022

Bernard_XLD à dit:
Bonjour AxelViens, cp4, le forum

@cp4 , à mon humble avis, le .Value en destination est de trop !

Cordialement, @+

Bonjour,

@Bernard_XLD : En effet le .Value est de trop. C'est l'effet du copier/coller par omission.

Bonne journée.

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

AxelViens

XLDnaute Nouveau

Phil69970

cp4

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

AxelViens

XLDnaute Nouveau

cp4

XLDnaute Barbatruc

Discussions similaires