Discussion :

[Faaab]

Tout d'abord je tiens à remercier tous ceux qui en répondant aux problèmes de tout le monde, m'ont bcp aidé!!!


Mon problème ne me semblais pas tres compliqué au début, mais la... je commence a souffrire un peu...

Il s'agit simplement de balayer la premiere ligne de tous les onglets d'un fichier SOURCE.XLS, pour recopier dans l'unique onglet d'un fichier CIBLE.XLS uniquement les colonnes dont la premiere ligne = ClasseA

Je m'explique...

===================Fichier SOURCE.XLS:=======================

+/- 15 onglets, (France, All, GB....)

Chaque onglet a une structure identique

En haut de chaque colonne est renseigné qq chose; ClassseA, B, C ou -

=================== Fichier CIBLE.XLS=======================

Vierge avant macro
Apres: tte les colonnes de la classe A ,uniquement, juxtaposées, sans blanc de préférence.

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
45
46
47
48
49
50
51
52
53
54
Sub Onglets()
 
 
 
'Pour accelérer:
Application.ScreenUpdating = False
 
     ' Def des feuilles: SOURCE
Dim France  As Worksheet
    Set France = Workbooks("SOURCE.xls").Worksheets("France")
 
     ' Def des  CIBLE
Dim ClasseA As Worksheet
    Set ClasseA = Workbooks("CIBLE.xls").Worksheets("ClasseA")
Dim A As String
    A = "ClasseA"
 
 
     ' Def du Nombre de colonnes à copier
Dim nbHD
    nbHD = Application.CountIf(France.Rows("1:1"), A)
 
        ' Def CellStop : Limite des tableaux sources
Dim CellStop As Integer
    CellStop = France.UsedRange.Columns.Count
 
        ' Def Où Coller : Fin des tableaux cibles
Dim DerniereColonne As Integer
    DerniereColonne = ClasseA.UsedRange.Columns.Count
    DerniereColonne = DerniereColonne + 1
Dim CCible As Range
    Set CCible = ClasseA.Cells(1, DerniereColonne).EntireColumn.Select
 
'==============================================================================
 
For J = 1 To CellStop
 
    If France.Cells(1, J) = A Then
     France.Columns(J).Copy Destination:=CCible
    End If
Next
 
For J = 1 To DerniereColonne
 
    If ClasseA.Cells(1, J) <> A Then
        ClasseA.Columns(J).Delete
    J = J - 1
 
        If J = nbHD Then GoTo fin
    End If
Next
 
fin:
End Sub

En somme c un gros bordel...

Parti comme je suis parti je sent ke je v bosser sur des boucles et des GoTo à gogo avec tous les cas par cas...

Qu'en pensez vous?

Y a til qq chose de plus simple????


N'hésitez pas a me demander plus d'info!

[ouskel'n'or]

Bonjour Faab, bienvenue sur le forum.
Pour ce que j'ai compris de ton pb...

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
Dim CL1 as workbook
Dim CL2 as Workbook
Dim LaFeuille as worksheet
Dim Colonne as range
Dim NoColDestination  as byte
Set CL1 = Workbooks("SOURCE.xls")
Set CL2 = Workbooks("CIBLE.xls")
NoColDestination = 0
'Tu parcours toutes les feuilles du fichier source
For each LaFeuille in CL1.Worksheets
 
     'Tu parcours toutes les cellules de la ligne 1 de toutes les colonnes
     For each Colonne in LaFeuille.Range(Cells(1,1), Cells(1,Range("IV1").End(xlToLeft).Column))
         If Colonne = ClasseA then
              NoColDestination = NoColDestination + 1
              Columns(Colonne.Column).copy Destination:= _
             CL2.Worksheets("ClasseA").Columns(NoColDestination)
         endif
    Next colonne
Next feuille

Sans filet, donc... tu peux tester pour moi ?
Si tu as un pb... c'est possible... alors tu dis
A+


(Pense à mettre les balises Code sur ton code et évite le langage sms)

[Faaab]

J'ai adapté ton script:

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
Sub HELP()
 
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim Colonne As Range
Dim NoColDestination  As Byte
Set CL1 = Workbooks("SOURCE.xls")
Set CL2 = Workbooks("CIBLE.xls")
 
NoColDestination = 0
'Tu parcours toutes les feuilles du fichier source
For Each LaFeuille In CL1.Worksheets
 
     'Tu parcours toutes les cellules de la ligne 1 de toutes les colonnes
     For Each Colonne In LaFeuille.Range(Cells(1, 1), Cells(1, Range("IV1").End(xlToLeft).Column))
         If Colonne = "HD" Then
              NoColDestination = NoColDestination + 1
              Columns(Colonne.Column).Copy Destination:= _
             CL2.Worksheets("Feuil1").Columns(NoColDestination)
         End If
    Next Colonne
Next LaFeuille
 
End Sub

La structure est nettement plus simple que la mienne!!

Cependant, il me copie qu'une colonne, il lance le debbuger pour butter sur
"For Each Colonne In LaFeuille.Range(Cells(1, 1), Cells(1, Range("IV1").End(xlToLeft).Column))"
La Colonne copiée étant la premiere cible du premier onglet

Quelle opération a-t-il pu réalisé:

- Copier la première puis butter?
- Dans mon premier Onglet il n'y a en réalité qu'une colonne cible, Il a pu butter sur le passage de For Each Colonne à For Each LaFeuille?
- Dans le second Onglet il n'y a pas de Colonne Cible, ... Bug possible?
- Dans le troisieme il y en a 2///


Je ne sait pas trop comment faire:

- Faut il faire une boucle par colonne copiée avec un GOTO? même si For Each il y a...???


Je t'envoi un bout de mon fichier dans 10 min our que tu ai la démo...

Merci encore de ton aide "ouskel'n'or"

[Faaab]

Source1 ci-joint:

un format xls
un format txt a reconvertir biensur!

Macro en cours de modif dans MODUL1

Merci encore...

[ouskel'n'or]

Autant pour moi, teste avec

Code :

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

     For each Colonne in LaFeuille.Range(Cells(1,1), Cells(1,LaFeuille.Range("IV1").End(xlToLeft).Column))

Tu dis
A+

[Faaab]

Il me donne le même message que tout à l'heure:

Cf Copies écrant jointes! (tt est a convertir en BMP, merci )


Je ne comprend pas car je fais tourner chaque boucle indépendament et ça marche....

Merci encore une fois de ta réactivité! ca fait plaisir de voir que sur ce forum tout vas tres vite!!!

[Faaab]

Je pense que c au niveau de la def de variable!

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
Sub HELP()
 
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim Colonne As Range
Dim NoColDestination  As Byte
Set CL1 = Workbooks("SOURCE.xls")
Set CL2 = Workbooks("CIBLE.xls")
 
NoColDestination = 0
'Tu parcours toutes les feuilles du fichier source
For Each LaFeuille In CL1.Worksheets
 
     'Tu parcours toutes les cellules de la ligne 1 de toutes les colonnes
     For Each Colonne In LaFeuille.Range(Cells(1, 1), Cells(1, LaFeuille.Range("A1").End(xlToRight).Column))
         If Colonne = "ClasseA" Then
              NoColDestination = NoColDestination + 1
              Columns(Colonne.Column).Copy Destination:=CL2.Worksheets("Feuil1").Columns(NoColDestination)
         End If
    Next Colonne
Next LaFeuille
 
End Sub

Il doit falloire préciser "Colonne" mais j'ai beau chercher sur des forum, je ne trouve aps ce qui cloche...

[ouskel'n'or]

Quand je mets

Cells(1, LaFeuille.Cells(1,LaFeuille.Range("IV1").End(xlToLeft).Column))

dans une ligne de code, ce n'est pas pour que tu le remplaces par

Range(Cells(1, 1), Cells(1, LaFeuille.Range("A1").End(xlToRight).Column))

Si tu mets ton code et que tu as un trou dans ta ligne, tu manques la fin de ta ligne

Mais pour plus de sureté, fais ça en deux temps
Dans les déclarations

Code :

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

Dim Plage as range

Et après la ligne for each Lafeuille...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
For each LaFeuille in CL1.Worksheets
     Set Plage = LaFeuille.Range(Cells(1,1), Cells(1, LaFeuille.Range("IV1").End(xlToLeft).Column))
 
     'Tu parcours toutes les cellules de la ligne 1 de toutes les colonnes
     For each Colonne in Plage
         If Colonne = ClasseA then
              NoColDestination = NoColDestination + 1
              Columns(Colonne.Column).copy Destination:= _
             CL2.Worksheets("ClasseA").Columns(NoColDestination)
         endif
         set Plage = NoThing
    Next colonne
Next feuille

Tu dis
A+

Edit
Si ClasseA est un string, corrige

[Faaab]

J'ai déjà essayé en rajoutant une variable...

Même en utilisant ton code avec la variable, il me renvoi le même message d'erreur:

"ERREUR D'EXECUTION '1004':
La METHODE 'RANGE' de l'objet '_Worksheet' a échoué

et il me selectionne ds le debug la ligne " Set Plage =///"

Le code marche-t-il sur ta machine?

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
Sub HELP()
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim Colonne As Range
Dim Plage As Range
Dim NoColDestination  As Byte
Set CL1 = Workbooks("SOURCE.xls")
Set CL2 = Workbooks("CIBLE.xls")
 
NoColDestination = 0
'Tu parcours toutes les feuilles du fichier source
For Each LaFeuille In CL1.Worksheets
     Set Plage = LaFeuille.Range(Cells(1, 1), Cells(1, LaFeuille.Range("IV1").End(xlToLeft).Column))
 
     'Tu parcours toutes les cellules de la ligne 1 de toutes les colonnes
     For Each Colonne In Plage
         If Colonne = "ClasseA" Then
              NoColDestination = NoColDestination + 1
              Columns(Colonne.Column).Copy Destination:= _
             CL2.Worksheets("Feuil1").Columns(NoColDestination)
         End If
         Set Plage = Nothing
    Next Colonne
Next LaFeuille
End Sub

En réalité, il va copier la colonne "Poire" (soit la seule cible de la Feuil1) puis bugguer... Humm


Oui j'avais fais des tests avc un xlToRight... ca change pas grand chose mais g t tellement desespéré que je me suis dit pourquoi pas...


Tu vois je ne sais vraiment aps ou ca bug... alors si tu peux jetter un oeil sur le fichier...


Merci M. l' Modérateur

Note du modérateur
Balise ton code correctement : En mode Edition, sélection du code + 1 Clic sur #
Pour corriger -> 1 clic sur Editer ! Non mais !

[ouskel'n'or]

Revu et corrigé

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
Sub HELP()
Dim CL1 As Workbook
Dim CL2 As Workbook
Dim LaFeuille As Worksheet
Dim Colonne As Range
Dim NoColDestination  As Byte
    Set CL1 = Workbooks("SOURCE.xls")
    Set CL2 = Workbooks("CIBLE.xls")
 
    NoColDestination = 0
    'Tu parcours toutes les feuilles du fichier source
    For Each LaFeuille In CL1.Worksheets
        'Tu parcours toutes les cellules de la ligne 1 de toutes les colonnes
        For Each Colonne In LaFeuille.Range(LaFeuille.Cells(1, 1), _
            LaFeuille.Cells(1, LaFeuille.Range("IV1").End(xlToLeft).Column))
            If Colonne = "ClasseA" Then
                NoColDestination = NoColDestination + 1
                LaFeuille.Columns(Colonne.Column).Copy Destination:= _
                CL2.Worksheets("Feuil1").Columns(NoColDestination)
            End If
        Next Colonne
        Set Plage = Nothing
    Next LaFeuille
End Sub

Pour chaque cellule il est nécessaire de préciser la feuille concernée L'aurais-je oublié ?
A+

NB - Apprends à baliser ton code sinon

[ouskel'n'or]

Edit
Un truc important si tu ne veux pas avoir d'ennui en copiant des colonnes :
J'ai vu que tu avais des cellules fusionnées dans le fichier que tu nous as transmis :
Pour copier des colonnes entières, supprime toujours toutes les fusions de cellules dans tes feuilles de calculs sinon tu vas au devant de graves désillusions

[Faaab]

Ok, pour les cellules fusionnées.


En revanche, je suis obligé de rajouter une boucle

Code :

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

1
2
3
4
5
For Each ONGLET in...
    For Each Colonne in... Onglet
         if...
    Next Colonne
Next ONGLET

pour chaque onglet...


Il me semblais que l'interet des boucls For Each était justement de ne avoir a faire cette opération.

Dans mon code final j'ai donc une boucle par onglet, et suis obligé de rajouté une boucle si j'insere un onglet.


Mais bon, ca marche!!!