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!!!