Discussion :

[brutos2]

Bonjour,

Voilà mon soucis

J'ai 6 colonnes qui peuvent être de longueurs différentes et comporter des cellules vides et à partir de ces 6 colonnes en faire une seule qui reprendrait les infos des 6

En gros mettre les colonnes à la suite les unes des autres et idéalement supprimer les cellules vides (pour cette dernière action j'ai trouver une macro sur le forum)

Merci d'avance à tous

[bidou]

quel version d'Excel ?

[brutos2]

ma version d'excel est la 2002

[jmfmarques]

Si ta version te permet de faire ces opérations manuellement, elles peuvent également être effectuées par du code.

Vois ce que je viens d'écrire, il y a quelques instants, à Ogenki (2ème page) à propos du sujet :
http://www.developpez.net/forums/viewtopic.php?t=443797

en ce qui concerne l'utilisation de l'enregistreur de macros.

Tu y trouveras un peu de bonheur...

[brutos2]

Merci pour le truc ... avec ceci j'ai réussi plus ou moins à résoudre mon problème

J'arrive bien à compiler mes 6 colonnes en une seule et y ajouter un entete (je fais un tableau dynamique croisé sur la colonne créée) ...

Sauf que cela bugge si j'ai une cellule vide comme première cellule de mes colonnes ...

[bidou]

avec quel code ?

[brutos2]

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub Macro4()
 
'Positionnement sur la feuille Base et copie des 6 colonnes
    Sheets("Base").Select
    Columns("F:K").Select
    Selection.Copy
 
    Range("DT1").Select
    ActiveSheet.Paste
    Range("DT5:DY6").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
 
'Faire une seule colonne avec les 6 de départ
    Range("DT7:DT" & [DT65536].End(xlUp).Row).Select
    Selection.Copy
    Range("DU65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
 
    Range("DU7:DU" & [DU65536].End(xlUp).Row).Select
    Selection.Copy
    Range("DV65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
 
    Range("DV7:DV" & [DV65536].End(xlUp).Row).Select
    Selection.Copy
    Range("DW65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
 
    Range("DW7:DW" & [DW65536].End(xlUp).Row).Select
    Selection.Copy
    Range("DX65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
 
    Range("DX7:DX" & [DX65536].End(xlUp).Row).Select
    Selection.Copy
    Range("DY65536").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
 
    Columns("DQ:DX").Select
    Selection.Delete Shift:=xlToLeft
 
'Ecriture du titre de colonne pour pouvoir calculer un tableau dynamique dessus
    Range("DQ6").Select
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Patho"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B7").Select
 
 
End Sub

[jmfmarques]

Le problème est peut être gébéré par l'exécution de cette ligne :

Code :

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

With ActiveCell.Characters(Start:=1, Length:=5).Font

qui devrait semble-t-il être précédée d'une condition (si la cellule est vide)

[bidou]

pour tout remonter en première colonne j'aurais plutôt employé un code du type

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim MaPlage As Range, cmpt As Long
 
Set MaPlage = Columns("A:F").SpecialCells(xlCellTypeBlanks)
'vire les cellules vides
MaPlage.Delete xlUp
'remonte toute les valeurs sur la première colonne
Set MaPlage = Columns("A:A")
For cmpt = 1 To 5
    MaPlage.Offset(, cmpt).SpecialCells(xlCellTypeConstants).Copy Destination:=MaPlage.End(xlDown).Offset(1)
Next
Columns("B:F").ClearContents