Discussion :

[capi81]

Bonjour le forum



J’ai le code ci-dessous qui me permet de faire un traitement feuille par feuille.

Je sélectionne la feuille active et j’exécute la macro et la plage définie est copiée et collée sur la feuille « CENTRALISATION ».

J’ai essayé de réaménager le code pour qu’à l’exécution le traitement de fasse sur toutes les feuilles sauf celles exclues.

Maintenant je souhaite qu’à chaque collage, le code agence (valeur de cellule ) s’affiche sur la colonne A.

NB : je vais illustrer la plage de la colonne A par un exemple pour faciliter la compréhension.

Si le collage se fait sur la plage B2 :B10 par exemple, la plage de la colonne A à affecter par la valeur de E9 est la plage A2 :A10.

Telle est ma demande et souhaite vos interventions à l’accoutumé.

Ci-dessous mon 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
Dim sh As Worksheet
 
Dim O As Worksheet
 
Set O = Sheets("CENTRALISATION")
 
Dim DEST As Range
 
Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))
 
    For Each sh In Worksheets
 
    If sh.Name <> "ANC_RC" And sh.Name <> "NVEL_RC" And sh.Name <> "CENTRALISATION" Then
 
        sh.Select
 
         Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
 
        Sheets("NVEL_RC").Range("A1:I94"), Unique:=False
 
        Range("A13:I350").Copy DEST
 
    End If
 
    Next sh

[Marc-L]

Bonjour,

merci encore une fois de commencer par respecter les règles de ce forum, à savoir baliser le code ‼

[parmi]

Bonjour,

mets cette ligne au début de ta boucle

Code :

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

Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))

[capi81]

Bonsoir a tous
Marc-L: avec un smartphone on a pas toutes les options pour travailler sur ce forum voilà pourquoi mes codes ne sont pas balisé..
Parmi: votre solution ne resoud pas mon problème..

[Marc-L]

Comme si le Copier/Coller eut été réalisé avec un smartphone !

Ne pas être étonné à force de ne plus obtenir de réponse …  

[RyuAutodidacte]

Bonsoir,

Code :

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

   ' Voilà je viens de faire le  balisage avec mon phone

Et encore mieux :

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
Dim sh As Worksheet
 
Dim O As Worksheet
 
Set O = Sheets("CENTRALISATION")
 
Dim DEST As Range
 
Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))
 
For Each sh In Worksheets
 
If sh.Name <> "ANC_RC" And sh.Name <> "NVEL_RC" And sh.Name <> "CENTRALISATION" Then
 
sh.Select
 
Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
 
Sheets("NVEL_RC").Range("A1:I94"), Unique:=False
 
Range("A13:I350").Copy DEST
 
End If
 
Next sh

Toujours de mon phone avec le copier/coller … comme quoi c'est possible !!!!

C'est sur cela prends un peu plus de temps, mais l'effort est fait !!! Et les règles sont respectées !!!
C'est qd même plus lisible …

Salut Marc

[capi81]

Salut a tous
Je mexcuse beaucoup pour ce désagréments. La répartition de mon PC est bientôt fini donc cava plus se repérer.
Merci de me donner le coup de main attendu.
NB: merci d'avoir balisé mon code.

[parmi]

Bonsoir a tous
Parmi: votre solution ne resoud pas mon problème..

Et quel est le problème plus exactement ?

[capi81]

Bonsoir Parmi et le forum

mets cette ligne au début de ta boucle

Peut être que vous n'avez pas bien cerné mon besoin.
Avec le code ci-dessous modifié, vous allez certainement mieux me comprendre.
J'ai essayé de le bricoler suivant ma logique mais il fonctionne pas comme je souhaite:
- il ne colle pas bien les données:mois je souhaite que les éléments filtrés seulement soit copiés et collés sur la feuille de destination,
- aussi la colonne A n'est pas renseignée par la valeur de la cellule E9 : en effet lorsque des éléments d'une feuille sont copiés sur la feuille de destination, après collage sur la colonne B, les cellules vide de la colonne A doivent prendre la valeur de E9 (de la feuille copiée).
Merci de m'aider à parfaire mon code pour atteindre le résultat souhaité.

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
Dim sh As Worksheet
Dim O As Worksheet
Dim Max_ligne As Long
Dim i As Long
Set O = Sheets("CENTRALISATION")
Dim DEST As Range
 
    For Each sh In Worksheets
    Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))
    If sh.Name <> "NVEL_RC" And sh.Name <> "CENTRALISATION" And sh.Name <> "ANC_RC" Then
        'sh.Select
         sh.Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("NVEL_RC").Range("A1:I94"), Unique:=False
        Range("A13:I350").Copy DEST
    End If
    'Inscription de la valeur de la cellule E9 en colonne A si b non vide, ou b rempli de blancs
    For i = 2 To Max_ligne
        If Replace(Cible.Cells(i, 2).Value, " ", "") <> "" Then
        O.Cells(i, 1).Value = sh.Range("E9").Value
    End If
    Next i
    Next sh

[parmi]

Que vaut Cible?
On ne voit pas comment cette variable est initialisée...

[capi81]

Bonjour Parmi
Ce moi cette ligne est mise en commentaire.
Ca m'a échappé.
Sans cela pensez-vous que le code est correct de par sa conception?

[parmi]

Pour le remplissage de la colonne A, j'opterais pour 2 variables: Debut et Fin

Après la copie des données d'un onglet,

Code :

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

1
2
3
Debut = O.Cells(Rows.count,"A").end(xlup).row + 1
Fin = O.Cells(Rows.count,"B").end(xlup).row
O.Range("A" & Debut & ":A" & Fin) = Sh.Range("E9")

[capi81]

Bonjour Parmi et le forum

Je m'excuse du temps de réaction.
J'attendais de reprendre mon PC pour pouvoir baliser mes codes et autres avant de poster.
Est-ce comme cela que je devrait intégrer votre solution?

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
Dim sh As Worksheet
Dim O As Worksheet
Dim Max_ligne As Long
Dim i As Long
Dim Debut as range, Fin as range
Set O = Sheets("CENTRALISATION")
Dim DEST As Range
 
    For Each sh In Worksheets
    Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))
    If sh.Name <> "NVEL_RC" And sh.Name <> "CENTRALISATION" And sh.Name <> "ANC_RC" Then
        'sh.Select
         sh.Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("NVEL_RC").Range("A1:I94"), Unique:=False
        Range("A13:I350").Copy DEST
    End If
    'Inscription de la valeur de la cellule E9 en colonne A si b non vide, ou b rempli de blancs
         Debut = O.Cells(Rows.count,"A").end(xlup).row + 1
         Fin = O.Cells(Rows.count,"B").end(xlup).row
         O.Range("A" & Debut & ":A" & Fin) = Sh.Range("E9")
 
    End If
    Next i
    Next sh

J'ai déclaré Debut et Fin comme range est-ce correct?

[parmi]

Non, debut et fin devraient être des Long puisque ce sont des lignes qu'on recherche
De plus, tu n'as pas besoin du IIF sur cette ligne

Code :

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

Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))

Ceci devrait suffire

Code :

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

Set DEST = O.Cells(Rows.Count, 2).End(xlUp).Row + 1

[capi81]

Bonsoir Parmi et le forum

Je viens de tester le code ci-dessus suivant vos recommandations mais il ne fonctionne pas bien.

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
Dim sh As Worksheet
Dim O As Worksheet
Dim Max_ligne As Long
Dim i As Long
Dim Debut as long, Fin as long
Set O = Sheets("CENTRALISATION")
Dim DEST As Range
 
    For Each sh In Worksheets
    'Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))
    Set DEST = O.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If sh.Name <> "NVEL_RC" And sh.Name <> "CENTRALISATION" And sh.Name <> "ANC_RC" Then
        'sh.Select
         sh.Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("NVEL_RC").Range("A1:I94"), Unique:=False
        Range("A13:I350").Copy DEST
    End If
    'Inscription de la valeur de la cellule E9 en colonne A si b non vide, ou b rempli de blancs
         Debut = O.Cells(Rows.count,"A").end(xlup).row + 1
         Fin = O.Cells(Rows.count,"B").end(xlup).row
         O.Range("A" & Debut & ":A" & Fin) = Sh.Range("E9")
 
    End If
    Next i
    Next sh

Avec ce code je rencontre un bug

Code :

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

Set DEST = O.Cells(Rows.Count, 2).End(xlUp).Row + 1

Voici mes constats lorsque j'exécute la macro:
1- Toutes les feuilles sont filtrées suivant les conditions de filtrage.
2- la feuille "CENTRALISATION" ne pas impactée comme souhaité. En effet, les éléments filtrés et copiés de chaque feuille devraient être collés sur la feuille "CENTRALISATION". Je constate que certaines données d'une seule feuille sont collées et plus rien.
3- la colonne A n'est pas remplie par la valeur de le cellule E9 de chaque feuille...il n'y a que des 0 seulement.
Comment arriver à ma solution sachant (je reformule un peu mon besoin) que le code attendu devrait permettre par feuille le traitement suivant:
- Filtrer et copier les éléments souhaités suivant les conditions de filtrage définies
- Coller les données sur la feuille "CENTRALISATION" avec pour 1ère cellule de destination B2 (pour les prochains collage la cellule de destination devra être la dernière cellule vide de la colonne B)
- Alimenter les cellules vide de la colonne A par la valeur de la cellule E9 de la feuille ou les données ont été copiées
-Passer à la feuille suivante et reproduire le même traitement en excluant les feuilles définies ("CODE", "CENTRALISATION").

[parmi]

Oups... enlève le SET et modifie la copie
J'ai fait un mauvais copier/coller de ton code...

Code :

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

1
2
3
4
5
6
7
    DEST = O.Cells(Rows.Count, 2).End(xlUp).Row + 1
    If sh.Name <> "NVEL_RC" And sh.Name <> "CENTRALISATION" And sh.Name <> "ANC_RC" Then
        'sh.Select
         sh.Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("NVEL_RC").Range("A1:I94"), Unique:=False
        Sh.Range("A13:I350").Copy O.Range("B" & DEST
    End If

Mais j'imagine que cette plage pourrait être mieux précisée (?)

Code :

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

Range("A13:I350")

[parmi]

Si tu veux copier la partie visible d'une plage qui a été filtrée, regarde du côté de SpecialCells(xlCellTypeVisible)

[capi81]

Bonsoir Parmi
Merci pour votre retour.
Je rencontre toujours le bug sur ce code :

Code :

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

DEST = O.Cells(Rows.Count, 2).End(xlUp).Row + 1

Message d'erreur : "Variable objet ou variable de bloc with non définie"
En remplaçant par mon ancien code

Code :

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

Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))

l'erreur se déplace sur cette partie du code :

Code :

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

Sh.Range("A13:I350").Copy O.Range("B" & DEST)

Message d'erreur : "Erreur définie par l'application ou par l'objet"
Voici le code intégral pour appréciation:

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
Dim sh As Worksheet
 
Set O = Sheets("CENTRALISATION")
 
Dim DEST As Range
 
'Set DEST = IIf(O.Range("B2").Value = "", O.Range("B2"), O.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0))
 
    DEST = O.Cells(Rows.Count, 2).End(xlUp).Row + 1
 
 
 
    For Each sh In Worksheets
 
    If sh.Name <> "CODE" And sh.Name <> "CENTRALISATION" Then
 
        'sh.Select
 
         sh.Range("A12:I731").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
 
        Sheets("CODE").Range("A1:I94"), Unique:=False
 
        sh.Range("A13:I350").Copy O.Range("B" & DEST)
 
    End If
 
    Next sh

Edit:

Code :

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

Range("A13:I350")

voulez-vous faire allusion à usedrange?
Comment l'utiliser sachant que la copie devrait commencer par A13?

[parmi]

Déclare DEST as Long

[capi81]

Je viens de reterser et le résultat a un peu évolué mais pas satisfaisant.
Toutes les feuilles ont été filtrées mais le copier-coller sur la feuille de destination ne s'est pas bien déroulée.
Je vous joints un fichier pour appréciation avec le résultat attendu sur la feuille "RESULTAT_ATTENDU".
Si tout se passe bien, le résultat sur la feuille "CENTRALISATION" devrait être comme sur la feuille "RESULTAT_ATTENDU".
La macro attendue devra permettre de filtrer chaque feuille et copier les données filtrés et les coller sur la feuille "CENTRALISATION" et alimenter les cellules vides de la colonne A par la valeur de E9.
Voici le lien : https://www.cjoint.com/c/HCbt2enLD