Discussion :

[zealot37]

Bonjour le forum,

je bloque :
je souhaite copier plusieurs cellules vers des feuilles différentes en fonction du premier chiffre de l'une d'entre elle...

voici le bout de 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
34
35
36
37
38
39
Sub uplod()
 
Dim cell As Range, plage As Range
Dim derlig As Long, newlig As Long
 
With Worksheets("BASE_AM")
.Range("a2:d3000").Clear
 
'with Worksheets("BASE_CB")
'.Range("a2:d3000").Clear
' end with
 
With Worksheets("MACROS_TRI")
derlig = Range("A" & Rows.Count).End(xlUp).Row
Set plage = Range("A2:A" & derlig)
End With
 
newlig = 1
   For Each cell In plage
         If Left(cell.Offset(0, 9).Value, 1) = "6" Then
           .Range("A" & newlig).Value = cell.Offset(0, 2).Value
           .Range("B" & newlig).Value = cell.Offset(0, 3).Value
           .Range("C" & newlig).Value = cell.Offset(0, 10).Value
           .Range("D" & newlig).Value = cell.Offset(0, 9).Value
     Else
        If Left(cell.Offset(0, 9).Value, 1) = "8" Then
            .Range("A" & newlig).Value = cell.Offset(0, 2).Value
            .Range("B" & newlig).Value = cell.Offset(0, 3).Value
            .Range("C" & newlig).Value = cell.Offset(0, 10).Value
            .Range("D" & newlig).Value = cell.Offset(0, 9).Value
         End If
       End If
     newlig = newlig + 1
 
 
    Next cell
    Set plage = Nothing
End With
End Sub

J'aimerais que ma seconde condition copier les cellules vers la feuille BASE_CB mais après moulte essais je n'arrive pas à définir la feuille cible

Quelqu'un peut-il m'aider svp ?

[Philippe Tulliez]

Bonjour,
Je pencherais pour une solution basée sur le Filtre avancé (élaboré).
Il faut définir une zone Data, une zone critères et il y a une option Copié vers

[zealot37]

Bonjour Philippe,

merci pour cette réponse.
Je pensais sinon le faire en 2x, avec le même premier bloc with mais en changeant simplement la de nom de feuille et faire un call en fin de premiere procédure pour que ce qui n'est pas pris dans le première (le if left = 6) soit finalement repris dans la seconde...

parce que j'avoue que la zone date et zone critère je ne sais pas trop de quoi il s'agit...

[Philippe Tulliez]

Bonjour,

parce que j'avoue que la zone date et zone critère je ne sais pas trop de quoi il s'agit...

Il ne s'agit pas de zone date mais de zone Data, c'est à dire la table de données
Pour utiliser un filtre élaboré, il faut au moins une table de données et une zone de critères.
1. La table de données doit avoir en première ligne les étiquettes de colonne.
2. La zone de critère doit avoir en première ligne des étiquettes de colonnes et au moins une ligne avec un ou plusieurs critères.
Par exemple si dans ta table de données, tu as une colonne qui contient le Chiffre d'affaires et dont l'étiquette de colonne se nomme CA et que tu veux extraire toutes les données dont le chiffre d'affaires est supérieur à 1500.
Dans la zone des critères, qui se situe par exemple dans une feuille nommée Paramètre. En A1, tu vas répéter le nom de l'étiquette CA et en A2, tu écris >1500.
Si c'est le seul critère, on définira comme zone de critère Paramètre!A1:A2.
Ensuite pour l'exportation des données répondant aux critères, on référencera la zone Copier vers
Tout cela est transposable en code VBA.

Bonsoir,
Voir ici un lien traitant du même sujet avec un code exemple.

[patricktoulon]

bonsoir

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
 
Sub uplod()
 
Dim cell As Range, plage As Range
Dim derlig As Long, newlig As Long
 Dim feuille1 As worksheet, feuille2 As worksheet
feuille1 = "ce que tu veux ici"
feuille2 = "ce que tu veux ici"
 
With Worksheets("BASE_AM")
.Range("a2:d3000").Clear
 
With Worksheets("MACROS_TRI")
derlig = Range("A" & Rows.Count).End(xlUp).Row
Set plage = Range("A2:A" & derlig)
End With
 
newlig = 1
 
 
   For Each cell In plage
         If Left(cell.Offset(0, 9).Value, 1) = "6" Then
          feuille1 .Range("A" & newlig).Value = cell.Offset(0, 2).Value
           feuille1.Range("B" & newlig).Value = cell.Offset(0, 3).Value
           feuille1.Range("C" & newlig).Value = cell.Offset(0, 10).Value
           feuille1.Range("D" & newlig).Value = cell.Offset(0, 9).Value
     Else
        If Left(cell.Offset(0, 9).Value, 1) = "8" Then
           feuille2 .Range("A" & newlig).Value = cell.Offset(0, 2).Value
            feuille2.Range("B" & newlig).Value = cell.Offset(0, 3).Value
            feuille2.Range("C" & newlig).Value = cell.Offset(0, 10).Value
            feuille2.Range("D" & newlig).Value = cell.Offset(0, 9).Value
         End If
       End If
     newlig = newlig + 1
 
 
    Next cell
    Set plage = Nothing
End With
End Sub

au plaisir

[Philippe Tulliez]

Bonjour,
Un autre lien qui traite du même sujet et qui n'est pas basé sur le filtre avancé avec code VBA à la clé.

[zealot37]

Bonsoir,

Patrick, merci pour le code corrigé. Il me semble avoir testé cette solution sans succès. Je refais le test demain avec mon fichier et reviens donné le résultat !!

Philippe, merci pour les liens, je vais creuser de ce coté aussi et m'instruire un peu (beaucoup...)