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