Discussion :

[Dean413]

Bonjour à tous,

Avant tout, j'espère ne pas avoir ouvert une nouvelle discussion pour rien, car je vous assure avoir vraiment cherché.

Donc voilà, je cherche à transférer des données d'un tableau (les colonnes 1, 2 et 3) à la condition que la colonne 4 soit vérifiée (dans mon exemple condition ="oui").
Le transfert s'effectue du tableau A (feuil1) à un autre tableau B (feuil2). Dans la pièce jointe, j'ai réalisé ces tableaux et ces données de la manière décrites.
Dans le tableau A, j'ai 40 lignes de données à la suite et dans le tableau B, j'ai un tableau à 2 sections (face à face), i.e. de 1 à 20 et puis de 21 à 40. J'ai réussi à écrire une macro qui me permet de réaliser le transfert, avec vérification de la condition ("oui"), mais je n'arrive pas à trouver un moyen de compiler le "copier/coller" de manière à ce qu'il débute de 1 à 20, puis qu'il continue sur la prochaine sélection, de 21 à 40.

Voilà, en gros, là où j'en suis... Et je suis un petit peu perdu car je songeais à quelque chose comme une boucle mais je ne sais pas du tout comment utiliser celle-ci de la bonne manière. C'est sur ce sujet, là, que je demande votre aide. S'il vous plait.

Cordialement,
Dean413.

P.S. : je suis plutôt novice en langage VBA donc je dois certainement passer à côté d'une chose évidente pour certains.
Donc merci d'avance, pour toutes vos réponses.

[Invité]

Bonjour,

A tester :
Nb : Ce code copie les cellules dans les tableaux cibles 1 et 2 relativement à leurs positions dans la feuille 1.

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
 
Sub Edit_V2()
 
Dim LigneEnCours As Integer
Dim AireSource As Range
 
  Set AireSource = Sheets("1").Range("Choix")
 
  With Sheets("2")
       .Range("Tableau1").ClearContents
       .Range("Tableau2").ClearContents
  End With
 
  For LigneEnCours = 1 To AireSource.Count
      If LigneEnCours <= 20 Then
         If LCase(AireSource(LigneEnCours)) = "oui" Then
            Range(AireSource(LigneEnCours).Offset(0, -3), AireSource(LigneEnCours).Offset(0, -1)).Copy Destination:=Sheets("2").Cells(LigneEnCours + 1, 2) ' + 1 pour la ligne de titre
         End If
      Else
         If LCase(AireSource(LigneEnCours)) = "oui" Then
            Range(AireSource(LigneEnCours).Offset(0, -3), AireSource(LigneEnCours).Offset(0, -1)).Copy Destination:=Sheets("2").Cells(LigneEnCours - 20 + 1, 6)
         End If
      End If
  Next LigneEnCours
 
  Set AireSource = Nothing
 
End Sub

[Dean413]

Bonjour Eric KERGRESSE,

Merci pour cette réponse, et en plus à 03h42.
Donc j'ai passé quelques temps hier soir à essayer différentes manipulations avec votre Sub(), mais je n'arrive
toujours pas à en faire ce que je veux. Ainsi, j'ai réadapté mon fichier Excel, afin d'être d'avantage plus clair
concernant mes explications. Je pense que nous sommes sur la bonne voie il manque juste un petit détail
que j'ai précisé en annotation dans le ficher.

Si je devais mettre en phrases la fonction que je souhaite créer, cela donnerait :
- 1/ pour chaque "oui" de la colonne D, garde en sélection les valeurs des 3 colonnes de gauche (A, B et C) de la Feuil1
- 2/ au minimum 1 ligne de valeurs et au maximum 40 lignes de valeurs
- 3/ fais un collage spécial de la sélection dans les deux tableaux de la Feuil2
- 4/ les différentes lignes de valeurs de la sélection doivent se suivre lors du collage spécial dans la Feuil2
et passer du tableau1 au tableau2 lorsque ces données sont comprises de cette manière " 21 =< sélection =< 40 ".

C'est vraiment très bête parce que ma formule permet de faire la sélection avec la bonne méthode, qui ne
tient pas en compte des cases "vides" de la colonne D, et votre formule permet le collage spécial dans une
"destination :=" multiple. L'idéal serait l'harmonisation entre ces deux fonctions et c'est à cette étape que
je bute.

P.S. : j'ai tout simplement réécrit une ligne de votre code, car je souhaitais absolument conserver le "collage spécial".

[Invité]

A tester :

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
38
 
Sub Edit_V2()
 
Dim LigneEnCours As Integer, LigneF2 As Integer, ColonneF2 As Integer, NbOui As Integer
Dim AireSource As Range
 
    Application.ScreenUpdating = False
 
    Set AireSource = Sheets("1").Range("CHOIX")  ' Attention l'aire Choix ne contient pas toutes les lignes
                                                 ' dans votre tableau
    With Sheets("2")
         .Range("TableauAll").ClearContents
         LigneF2 = 1
         ColonneF2 = 2
    End With
 
    NbOui = 0
    For LigneEnCours = 1 To AireSource.Count
 
        If LCase(AireSource(LigneEnCours)) = "oui" And NbOui <= 40 Then
           Range(AireSource(LigneEnCours).Offset(0, -3), AireSource(LigneEnCours).Offset(0, -1)).Copy
           Sheets("2").Cells(LigneF2 + 1, ColonneF2).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=False
           LigneF2 = LigneF2 + 1
           NbOui = NbOui + 1
        End If
 
        If NbOui = 20 Then
           LigneF2 = 1
           ColonneF2 = 6
        End If
 
    Next LigneEnCours
 
    Set AireSource = Nothing
 
    Application.ScreenUpdating = True
 
End Sub

[Dean413]

Bonsoir Eric KERGRESSE,

Je vous remercie parce que j'aurai certainement fêté quelques anniversaires avant de trouver la solution.
C'est exactement ça, j'ai tout simplement ajouté d'autres lignes de code pour vraiment bloquer la fonction,
si le nombre de valeurs max autorisées était dépassé, mais à part ça c'est vraiment nickel. Merci beaucoup !

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
38
39
40
41
42
43
44
Sub Edit()
 
Dim LigneEnCours As Integer, LigneF2 As Integer, ColonneF2 As Integer, NbOui As Integer
Dim AireSource As Range
 
    Application.ScreenUpdating = False
 
    Set AireSource = Sheets("1").Range("CHOIX")
 
    With Sheets("2")
         .Range("TableauAll").ClearContents
         LigneF2 = 1
         ColonneF2 = 2
    End With
 
    NbOui = 0
    For LigneEnCours = 1 To AireSource.Count
 
        If WorksheetFunction.CountA(AireSource) > 40 Then
        MsgBox "40 valeurs autorisées, au maximum ! Vous avez " & WorksheetFunction.CountA(AireSource) - 40 & _
        " valeur(s) en trop."
        Exit Sub
        End If
 
        If LCase(AireSource(LigneEnCours)) = "oui" And NbOui <= 40 Then
           Range(AireSource(LigneEnCours).Offset(0, -3), AireSource(LigneEnCours).Offset(0, -1)).Copy
           Sheets("2").Cells(LigneF2 + 1, ColonneF2).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=False
           LigneF2 = LigneF2 + 1
           NbOui = NbOui + 1
 
        End If
 
        If NbOui = 20 Then
           LigneF2 = 1
           ColonneF2 = 6
        End If
 
    Next LigneEnCours
 
    Set AireSource = Nothing
 
    Application.ScreenUpdating = True
 
End Sub

J'ai encore certains termes à adapter tout utiliser votre fonction sur le fichier Excel pour lequel j'en avais besoin
en premier lieu. Mais je pense que maintenant je vais pouvoir m'en sortir.

P.S. : bien vu pour le Range(CHOIX) !!