Microsoft 365 Dupliquer des lignes dans une autre feuille avec une condition

de_hanstrapp · 2 Août 2023

Bonsoir le forum,

Je cherche à dupliquer toutes les lignes de mon tableau qui répondent à une condition dans une autre feuille de mon classeur.

Actuellement, j'utilise le code VBA suivant mais il a un délais de réponse plutôt long...
Est-il possible d'optimiser la durée du traitement ?

Sub ExportAA()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("VILLE").Activate

Col = "H"
NumLig = 0
With Sheets("MATRICE")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value = "VILLE - Athènes" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
End If
Next
End With

End Sub

Merci par avance pour votre aide.
Bonne soirée,

de_hanstrapp

de_hanstrapp · 19 Août 2023

Jacky67 à dit:
Re.
Avant tout
Pour mes essais, j'avais placé cette ligne dans les codes
Application.EnableEvents = False
Il faut a tout pris la supprimer
Pour l'ellipse, je n'éprouve aucune difficulté elle n'est pas déformée chez moi.
Néanmoins vérifier dans ses propriétés et cocher
-Conserver les proportions
-Déplacer sans dimensionner avec les cellules
Sinon, je n'ai pas de solution dans ce cas.

Re, j'ai bien supprimé "Application.EnableEvents = False" du code.
J'ai bien vérifié les différentes propriétés et fait plusieurs tests. J'ai également vérifié que les hauteurs de lignes étaient identiques et c'est le cas. Tant pis !
Merci pour tout.
de_hanstrapp

Jacky67 · 20 Août 2023

de_hanstrapp à dit:
Re, j'ai bien supprimé "Application.EnableEvents = False" du code.
J'ai bien vérifié les différentes propriétés et fait plusieurs tests. J'ai également vérifié que les hauteurs de lignes étaient identiques et c'est le cas. Tant pis !
Merci pour tout.
de_hanstrapp

Re..
Dans cette version l'ellipse est aussi déformée ?.

de_hanstrapp · 20 Août 2023

Jacky67 à dit:
Re..
Dans cette version l'ellipse est aussi déformée ?.

Bonjour Jacky67,

Oui avec ta version cela fonctionne.

J'ai toutefois trouvé une autre alternative à force de chercher...
La déformation de toutes les formes se faisaient en hauteur donc j'ai écris ton cade ainsi :

VB:

With ActiveWorkbook.Sheets(1)
        .UsedRange.PasteSpecial Paste:=xlPasteColumnWidths
        .Rows(1).RowHeight = 31.25
        .Rows(2).RowHeight = 12.75
        .Rows(3).RowHeight = 12.75
        .Rows(4).RowHeight = 12.75
        .Rows(5).RowHeight = 12.75
        .Rows(6).RowHeight = 12.75
        .Rows(7).RowHeight = 12.75
        .Rows(8).RowHeight = 12.75
        .Rows(9).RowHeight = 12.75
        .Rows(10).RowHeight = 60
        .[a10].PasteSpecial Paste:=xlPasteFormats
        .[a10].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        ThisWorkbook.Sheets("MATRICE").Rows("1:9").Copy .[A1]
        .Name = LaVille: .[A1].Activate
    End With

Et là cela fonctionne également.

Bon dimanche.

de_hanstrapp

Jacky67 · 20 Août 2023

de_hanstrapp à dit:
Bonjour Jacky67,

Oui avec ta version cela fonctionne.

J'ai toutefois trouvé une autre alternative à force de chercher...
La déformation de toutes les formes se faisaient en hauteur donc j'ai écris ton cade ainsi :

VB:

With ActiveWorkbook.Sheets(1) .UsedRange.PasteSpecial Paste:=xlPasteColumnWidths .Rows(1).RowHeight = 31.25 .Rows(2).RowHeight = 12.75 .Rows(3).RowHeight = 12.75 .Rows(4).RowHeight = 12.75 .Rows(5).RowHeight = 12.75 .Rows(6).RowHeight = 12.75 .Rows(7).RowHeight = 12.75 .Rows(8).RowHeight = 12.75 .Rows(9).RowHeight = 12.75 .Rows(10).RowHeight = 60 .[a10].PasteSpecial Paste:=xlPasteFormats .[a10].PasteSpecial Paste:=xlPasteValuesAndNumberFormats ThisWorkbook.Sheets("MATRICE").Rows("1:9").Copy .[A1] .Name = LaVille: .[A1].Activate End With

Et là cela fonctionne également.

Bon dimanche.

de_hanstrapp

RE..
Je te laisse trouver comment écrire ce code
.Rows(2).RowHeight = 12.75
.Rows(3).RowHeight = 12.75
.Rows(4).RowHeight = 12.75
.Rows(5).RowHeight = 12.75
.Rows(6).RowHeight = 12.75
.Rows(7).RowHeight = 12.75
.Rows(8).RowHeight = 12.75
.Rows(9).RowHeight = 12.75
En une seule instruction.
Joker: Il y a un exemple un peu plus bas dans la même macro

de_hanstrapp · 20 Août 2023

Jacky67 à dit:
RE..
Je te laisse trouver comment écrire ce code
.Rows(2).RowHeight = 12.75
.Rows(3).RowHeight = 12.75
.Rows(4).RowHeight = 12.75
.Rows(5).RowHeight = 12.75
.Rows(6).RowHeight = 12.75
.Rows(7).RowHeight = 12.75
.Rows(8).RowHeight = 12.75
.Rows(9).RowHeight = 12.75
En une seule instruction.
Joker: Il y a un exemple un peu plus bas dans la même macro

.Rows("2:9").RowHeight = 12.75
Merci

de_hanstrapp · 21 Août 2023

Bonjour Jacky67,
Bonjour le forum,

Encore moi...

Comment adapter le code ci-dessous si je ne veux pas que dans l'onglet "VILLE" apparaissent les menus déroulant figurant dans l'onglet "MATRICE" que je viens d'ajouter... ?

VB:

Sub ExportAA()
    Sheets("VILLE").Activate
    Range("a11", Cells(Cells.Rows.Count, Cells.Find("*", , , , xlByColumns, xlPrevious).Column)).Clear
    With Sheets("MATRICE").[a10].CurrentRegion
        .AutoFilter Field:=8, Criteria1:="VILLE - Athènes"
        .SpecialCells(xlCellTypeVisible).Copy [a11]
        .AutoFilter
    End With
End Sub

Merci par avance pour votre aide.
Bonne journée,

de_hanstrapp

Jacky67 · 21 Août 2023

de_hanstrapp à dit:
Bonjour Jacky67,
Bonjour le forum,

Encore moi...

Comment adapter le code ci-dessous si je ne veux pas que dans l'onglet "VILLE" apparaissent les menus déroulant figurant dans l'onglet "MATRICE" que je viens d'ajouter... ?

VB:

Sub ExportAA() Sheets("VILLE").Activate Range("a11", Cells(Cells.Rows.Count, Cells.Find("*", , , , xlByColumns, xlPrevious).Column)).Clear With Sheets("MATRICE").[a10].CurrentRegion .AutoFilter Field:=8, Criteria1:="VILLE - Athènes" .SpecialCells(xlCellTypeVisible).Copy [a11] .AutoFilter End With End Sub

Merci par avance pour votre aide.
Bonne journée,

de_hanstrapp

Re..
Dans ce code, seule les lignes visibles après la ligne 10 sont copiées, si les contrôles sont placés avant cette ligne, il ne seront pas copiés.
Il faut évidemment les supprimer s'ils ont été copier précédemment.
Un contrôle ou la propriété "Ne pas déplacer ou dimensionner avec les cellules" est coché ne sera pas recopié
Mettre le classeur utilisé en ligne pour une suite éventuelle.

de_hanstrapp · 21 Août 2023

Jacky67 à dit:
Re..
Dans ce code, seule les lignes visibles après la ligne 10 sont copiées, si les contrôles sont placés avant cette ligne, il ne seront pas copiés.
Il faut évidemment les supprimer s'ils ont été copier précédemment.
Un contrôle ou la propriété "Ne pas déplacer ou dimensionner avec les cellules" est coché ne sera pas recopié
Mettre le classeur utilisé en ligne pour une suite éventuelle.

Bonjour Jacky,
Voici le fichier. Mon problème est "simplement" que si j'utilise une validation de données - liste dans l'onglet "MATRICE", cette dernière est copiée dans l'onglet "VILLE" chose que je ne souhaite pas dans la mesure du possible.
Merci pour le temps passé.

Jacky67 · 21 Août 2023

de_hanstrapp à dit:
Bonjour Jacky,
Voici le fichier. Mon problème est "simplement" que si j'utilise une validation de données - liste dans l'onglet "MATRICE", cette dernière est copiée dans l'onglet "VILLE" chose que je ne souhaite pas dans la mesure du possible.
Merci pour le temps passé.

Re..
Je ne vois aucune liste de validation....ni code qui y fait référence.
C'est de nouveau une autre structure.....
Il arrive un moment ou il faut savoir ce que l'on veut.

de_hanstrapp · 21 Août 2023

Bonsoir Jacky,

Je peux comprendre ton "agacement" mais j'essaie de faire évoluer mon fichier chemin faisant.
J'utilise les deux techniques que tu as partagées avec moi... et elles me servent.

Concernant la validation des données, elles se trouve en colonne H comme l'indique l'image ci-dessous :

Bonne soirée.

de_hanstrapp

Jacky67 · 21 Août 2023

de_hanstrapp à dit:
Bonsoir Jacky,

Je peux comprendre ton "agacement" mais j'essaie de faire évoluer mon fichier chemin faisant.
J'utilise les deux techniques que tu as partagées avec moi... et elles me servent.

Concernant la validation des données, elles se trouve en colonne H comme l'indique l'image ci-dessous :

Regarde la pièce jointe 1176869

Bonne soirée.

de_hanstrapp

Ok! Alors avec ce code

VB:

Sub ExportAA()
    Sheets("VILLE").Activate
    Range("a11", Cells(Cells.Rows.Count, Cells.Find("*", , , , xlByColumns, xlPrevious).Column)).Clear
    With Sheets("MATRICE").[a10].CurrentRegion
        .AutoFilter Field:=8, Criteria1:="VILLE - Athènes"
        .SpecialCells(xlCellTypeVisible).Copy
        [a11].PasteSpecial Paste:=xlPasteFormats
        [a11].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .AutoFilter
    End With
End Sub

de_hanstrapp · 21 Août 2023

Jacky67 à dit:

Ok! Alors avec ce code

VB:

Sub ExportAA()
    Sheets("VILLE").Activate
    Range("a11", Cells(Cells.Rows.Count, Cells.Find("*", , , , xlByColumns, xlPrevious).Column)).Clear
    With Sheets("MATRICE").[a10].CurrentRegion
        .AutoFilter Field:=8, Criteria1:="VILLE - Athènes"
        .SpecialCells(xlCellTypeVisible).Copy
        [a11].PasteSpecial Paste:=xlPasteFormats
        [a11].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .AutoFilter
    End With
End Sub

Merci Jacky67.
C'est parfait...

Microsoft 365 Dupliquer des lignes dans une autre feuille avec une condition

de_hanstrapp

XLDnaute Occasionnel

de_hanstrapp

XLDnaute Occasionnel

Jacky67

XLDnaute Barbatruc

Pièces jointes

de_hanstrapp

XLDnaute Occasionnel

Jacky67

XLDnaute Barbatruc

de_hanstrapp

XLDnaute Occasionnel

de_hanstrapp

XLDnaute Occasionnel

Jacky67

XLDnaute Barbatruc

de_hanstrapp

XLDnaute Occasionnel

Pièces jointes

Jacky67

XLDnaute Barbatruc

de_hanstrapp

XLDnaute Occasionnel

Jacky67

XLDnaute Barbatruc

Pièces jointes

de_hanstrapp

XLDnaute Occasionnel

Discussions similaires