Discussion :

[syd0112]

Bonjour à tous,


Je suis nouvelle sur ce forum, et je débute en VBA.
Je sollicite votre aide Voici mon problème

J'ai obtenu un code qui en fonction des lignes sélectionnées par "ok", lorsque l'on appuie sur le bouton charger, me copie les lignes sélectionnées dans une nouvelle feuille.
Cependant j'aimerais pouvoir conserver la mise en forme du texte lors de la copie, mais je ne sais pas ou insérer un PasteSpecial Paste=:XlPasteFormats dans toutes les boucles de ce code ...
Et je me demandais aussi s'il était possible que les cellules groupées reste groupées lors du collage ?
Je vous joints mon fichierBasededonnees4bis.xlsm

Merci pour votre aide

PS: Pour être honnête avec vous j'ai récupéré ce code sur un autre forum, cependant la personne qui me l'a donné n'a pas le temps de le modifier. Sans cette fonctionnalité je suis bloquée. J'espère qu'il y aura une âme charitable parmi vous...
Merci pour tout

[riaolle]

Bonjour et bienvenue sur le forum,
Peu de gens ouvrent les fichier joints. Il vaut mieux que tu nous donnes ton code (avec la balise code #), avec les endroits où tu bloques.
Sans ouvrir ton fichier, je te retourne une question : comment copies-tu tes valeurs? Utilises-tu la méthode PasteSpecial? Car avec la méthode PasteSpecial et xlPasteAll, tu devrais avoir la mise en forme de copiée aussi.

[Marc-L]

Bonjour,

et même sans PasteSpecial en utilisant uniquement la méthode Range.Copy comme détaillée dans l'aide VBA !

___________________________________________________________________________________________________________

Je suis Paris, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[syd0112]

Voici le code que j'utilise, il permet pas de copier-coller la mise en forme :/ ni de conserver les cellules groupées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Test()
Dim O1 As Worksheet 'déclare la variable O1 (onglet 1)
Dim O2 As Worksheet 'déclare la variable O2 (onglet 2)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
 
Set O1 = Worksheets("Filtre Famille") 'définit l'onglet O1
Set O2 = Worksheets("Feuil1") 'définit l'onglet O2
TV = O1.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
O2.Cells.ClearContents 'efface d'éventuelles anciennes valeur dans l'onglet O2
O2.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'recopie la ligne des en-têtes du tableau dans l'onglet O2
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    For J = 1 To NC 'boucle 1 : sur toutes les colonnes J du tableau des valeurs TV
        If UCase(TV(I, J)) = "OK" Then 'condition : si la données ligne I colonne J de TV (convertie en majuscule) est égale à "OK"
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau ds lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 sur toutes les lignes L du tableau des lignes TL
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (= Transposition)
            Next L 'prochaine ligne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à 1, renvoie dans A2 redimensionnée de l'onglet O2 le tableu TL transposé
If K > 1 Then O2.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
O2.Activate 'active l'onglet O2
End Sub

Merci pour votre aide

[Invité]

Bonjour,
Facilites nous la vision nocturne! (je sui pas nyctalope) Surligne ton code et click sur #.

[syd0112]

Re j'ai surligné et appuyé sur #

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Test()
Dim O1 As Worksheet 'déclare la variable O1 (onglet 1)
Dim O2 As Worksheet 'déclare la variable O2 (onglet 2)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
 
Set O1 = Worksheets("Filtre Famille") 'définit l'onglet O1
Set O2 = Worksheets("Feuil1") 'définit l'onglet O2
TV = O1.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
O2.Cells.ClearContents 'efface d'éventuelles anciennes valeur dans l'onglet O2
O2.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'recopie la ligne des en-têtes du tableau dans l'onglet O2
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
For J = 1 To NC 'boucle 1 : sur toutes les colonnes J du tableau des valeurs TV
If UCase(TV(I, J)) = "OK" Then 'condition : si la données ligne I colonne J de TV (convertie en majuscule) est égale à "OK"
ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau ds lignes TL (autant de lignes que TV a de colonnes, K colonnes)
For L = 1 To NC 'boucle 3 sur toutes les lignes L du tableau des lignes TL
TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (= Transposition)
Next L 'prochaine ligne de la boucle 3
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à 1, renvoie dans A2 redimensionnée de l'onglet O2 le tableu TL transposé
If K > 1 Then O2.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
O2.Activate 'active l'onglet O2
End Sub

Merci

[unparia]

Bonjour
Mis entre balises ou non, un code non indenté reste imbuvable et donne peu envie de le lire.

[syd0112]

Bonjour je l'ai rendu le plus visible possible.
Si vous pouviez m'aider se serait sympa. J'aimerais faire un copier-coller des lignes sélectionnées par ok tout en gardant la mise en forme et les cellules groupées.
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Dim O1 As Worksheet 'déclare la variable O1 (onglet 1)
Dim O2 As Worksheet 'déclare la variable O2 (onglet 2)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
 
Set O1 = Worksheets("Filtre Famille") 'définit l'onglet O1
Set O2 = Worksheets("Choix") 'définit l'onglet O2
TV = O1.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
O2.Cells.ClearContents 'efface d'éventuelles anciennes valeur dans l'onglet O2
O2.Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'recopie la ligne des en-têtes du tableau dans l'onglet O2
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    For J = 1 To NC 'boucle 1 : sur toutes les colonnes J du tableau des valeurs TV
        If UCase(TV(I, J)) = "OK" Then 'condition : si la données ligne I colonne J de TV (convertie en majuscule) est égale à "OK"
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau ds lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 sur toutes les lignes L du tableau des lignes TL
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (= Transposition)
            Next L 'prochaine ligne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
'si K est supérieure à 1, renvoie dans A2 redimensionnée de l'onglet O2 le tableu TL transposé
If K > 1 Then O2.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
O2.Activate 'active l'onglet O2
 
 
Sheets("Choix").Visible = True

[riaolle]

Bonjour,
Je suis pas sûre d'avoir tout bien compris dans ton code, mais j'ai l'impression que tu fais la chose suivante:

• Créer un tableau
• "Mettre" la plage à parcourir dans le tableau
• Parcourir le tableau
• Créer un tableau à partir du premier tableau en fonction d'une condition
• "Transformer" le deuxième tableau en plage.

Pourquoi tu passes par des tableaux? Pourquoi ne travailles tu pas directement avec ton classeurs Excel et tes cellules? Supposons, par exemple, que j'ai la plage suivante :

colonne A	colonne B
xxx	"OK" ou "NON"

Et qu'on veut copier seulement les ligne où il y a "OK" dans la colonne B:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub copieLigne()
    Dim i As Long   'ligne feuil1
    Dim j As Long   'ligne feuil2
    Dim n As Long   'nombre de ligne tableau feuil1
 
    j = 1   '1ère ligne où on va coller
    With Sheets("Feuil1")
        n = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 1 To n          'boucle sur lignes à copier si OK
            If .Range("B" & i).Value = "OK" Then
                .Rows(i).Copy
                Sheets("Feuil2").Range("A" & j).PasteSpecial
                j = j + 1   'prochaine ligne où on va coller
            End If
        Next i
    End With
End Sub

[syd0112]

Bonjour Riaolle

Votre code est beaucoup plus simple et il fonctionne parfaitement! Un grand Merci déjà !!!
Mais peut être que vous pouvez encore m'aider ...
Maintenant que le tableau des cellules sélectionnées est crée j'ai besoin de copier certaines ligne de ce tableau dans un autre tableau sous une cellule text choisit par une combobox. Voici ci-dessous le code que j'utilise. Mais ce code ne me permet pas de conserver la mise en page. Sauriez-vous adapter le code pour conserver la mise en forme ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim Plage As Range
    Dim Cel As Range
    Dim I As Integer
 
    With Worksheets("DStheorique"): Set Plage = .Range(.Cells(9, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
 
    Set Cel = Plage.Find(ComboBox1.Text, , xlValues, xlWhole)
 
    If Not Cel Is Nothing Then
 
        For I = ListBox1.ListCount To 1 Step -1
 
            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(I - 1)
            Cel.Offset(1, 4).Value = Worksheets("Choix").Cells(I + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Choix").Cells(I + 1, 9).Value
            Cel.Offset(1, 1).Value = Worksheets("Choix").Cells(I + 1, 5).Value
            Cel.Offset(1).Font.Bold = False
        Next I

End If

[riaolle]

En effet, en passant par la propriété Value de la cellule, on ne récupère que la VALEUR de la cellule et pas sa mise en forme. Il faut faire comme précédemment et faire un copier-coller des cellules voulues.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A1").Copy
Range("A2").PasteSpecial

[syd0112]

Je suis désolée mais je sais pas comment faire avec les I+1 du code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Cel.Offset(1, 4).Value = Worksheets("Choix").Cells(I + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Choix").Cells(I + 1, 9).Value
            Cel.Offset(1, 1).Value = Worksheets("Choix").Cells(I + 1, 5).Value

[riaolle]

Je ne comprends pas bien ta question.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Cel.Offset(1, 4).Copy
Worksheets("Choix").Cells(I + 1, 6).PasteSpecial

[syd0112]

Mon fichier est très complexe et je suis surement pas très clair.

J'ai un Userform Image 1, qui me permet de charger des données sous un lot choisi par une combobox Image 2.
Dans mon fichier il existe une feuille "Filtre Famille" c'est une base de données . Dans cette feuille l'utilisateur sélectionne par "OK" les lignes qu'il souhaite extraire. Ces lignes grâce à votre code sont copiées en conservant leur mise en forme dans la feuil "Choix".
et la ligne désignation est charger dans la listbox. Comme ça l'utilisateur voit les ressources qu'il est en train d'ajouter.

Maintenant c'est là que j'ai besoin de votre aide.
Lorsque j'appuie sur le bouton "fermer" de l'userform, je dois copier dans la feuille "DSthéorique" toutes les lignes de la feuille choix en gardant la mise en forme.

Le code comme vous me l'avez conseillé ne fonctionne pas :/

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Dim Plage As Range
    Dim Cel As Range
    Dim i As Integer
 
    With Worksheets("DStheorique"): Set Plage = .Range(.Cells(9, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
 
    Set Cel = Plage.Find(ComboBox1.Text, , xlValues, xlWhole)
 
    If Not Cel Is Nothing Then
 
        For i = ListBox1.ListCount To 1 Step -1
 
            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(i - 1)
            Cel.Offset(1, 4).Copy
            Worksheets("Choix").Cells(i + 1, 6).PasteSpecial
            Cell.Offset(1, 6).Copy
            Worksheets("Choix").Cells(i + 1, 9).PasteSpecial
            Cell.Offset(1, 1).Copy
            Worksheets(i + 1, 5).Copy
 
 
            Cel.Offset(1).Font.Bold = False
        Next i
 
    End If

[riaolle]

Quand tu dis "ne fonctionne pas" : tu as un message d'erreur? Si oui, lequel et où exactement? Le code tourne mais ne fait pas ce que tu veux? Si oui, que fait-il?

[syd0112]

La boucle ne tourne pas

[riaolle]

Comparons :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Cel.Offset(1, 4).Copy
Cell.Offset(1, 6).Copy

Il y a un "l" en trop !

[syd0112]

Je m'excuse pour cette faute de frappe. La boucle tourne, mais le résultat n'est pas celui attendu.
Les cellules de coller dans la feuille "DS theorique" n'ont pas le même format que ceux de la feuille "choix"

[riaolle]

C'est bizarre...

Bonjour Riaolle
Votre code est beaucoup plus simple et il fonctionne parfaitement! Un grand Merci déjà !!!
Mais peut être que vous pouvez encore m'aider ...

Est-ce que ça marchait sur le premier code dont tu parlais? Ou est-ce qu'on est toujours sur le même code que depuis le début?

Essaie avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Cel.Offset(1, 4).Copy
            Worksheets("Choix").Cells(i + 1, 6).Select
            Worksheets("Choix").Paste

[syd0112]

Voici mon ancien code

Pr

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
ivate Sub CommandButton2_Click()
 
 
 Dim Plage As Range
    Dim Cel As Range
    Dim i As Integer
 
    With Worksheets("DStheorique"): Set Plage = .Range(.Cells(9, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
 
    Set Cel = Plage.Find(ComboBox1.Text, , xlValues, xlWhole)
 
    If Not Cel Is Nothing Then
 
        For i = ListBox1.ListCount To 1 Step -1
 
            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(i - 1)
 
            Cel.Offset(1, 4).Value = Worksheets("Choix").Cells(i + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Choix").Cells(i + 1, 9).Value
            Cel.Offset(1, 1).Value = Worksheets("Choix").Cells(i + 1, 5).Value
 
            Cel.Offset(1).Font.Bold = False
        Next i
 
    End If

Il copiait 3 colonnes mais sans la mise en forme.




Avec votre Code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub CommandButton2_Click()
 
 
 Dim Plage As Range
    Dim Cel As Range
    Dim i As Integer
 
    With Worksheets("DStheorique"): Set Plage = .Range(.Cells(9, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
 
    Set Cel = Plage.Find(ComboBox1.Text, , xlValues, xlWhole)
 
    If Not Cel Is Nothing Then
 
        For i = ListBox1.ListCount To 1 Step -1
 
            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(i - 1)
            Cel.Offset(1, 4).Copy
            Worksheets("Choix").Cells(i + 1, 6).Select
            Worksheets("Choix").Paste
            Cel.Offset(1, 6).Copy
            Worksheets("Choix").Cells(i + 1, 9).Select
            Worksheets("Choix").Paste
            Cel.Offset(1, 1).Copy
            Worksheets("Choix").Cells(i + 1, 5).Select
            Worksheets("Choix").Paste
 
 
 
            Cel.Offset(1).Font.Bold = False
        Next i
 
    End If

Je n'ai pas la mise en forme non plus et il me manque des colonnes