Découper un tableau en plusieurs

Version imprimable

18/04/2013, 18h44
Matrixmax

Découper un tableau en plusieurs

Bonjour,

et grand merci à vous et à ce forume qui me fournit de l'aide lorsque je me bloque devant les MACRO. :D

Mon probléme consiste à découper mon tableau composé de "Cr" colonne en des petit tableau de 16 colonne chacun + la premiére colonne du grand tableau au début de chacun de mes petit tableau. :(

et puis la derniére partie du tableau qui contient moin de 16 colonne avec la premiére colonne aussi .

je suis vraiment bloqué la dessus . :( . et j'ai besoin de votre aide 8O

Merci infiniment ...
19/04/2013, 08h12
goldstar

Bonjour,

Faut il un petit tableau par feuille ou tous les petits tableaux sur la meme feuille.

pouvez-vous mettre un fichier exemple ?

Cordialement
19/04/2013, 16h01
Matrixmax

1 pièce(s) jointe(s)

Bonjour Chef ,

Sur la méme feuil sera parfait.

Tu trouveras ci-joint le tableau à découper .

Merci Innnnnfiniiiment d'avance ..
21/04/2013, 17h32
pyloupylou

A ta place, j'essaierai d'enregistrer en macro pour la création du premier découpage.
Ensuite en regardant le code, tu mets en variable ce qui doit progresser
et tu fais une boucle

du style, je te le fais en littéral:

1 / je copie mes colonnes qui doivent être conservées et les colles à l'emplacement du nouveau tableau avec
ligne = 1

-----début de boucle

selection de "A" & ligne &"A" ligne + 23
et coller en "A" & ligne +24 .

ensuite tu regardes sur: ligne+5, le nombre de colonne que tu as ( nbcol = application.worksheetfunction.range(ligne+5;ligne+5)

si > à une borne (x par exemple)
selection du range(cells(ligne,x+1),cells(ligne+23,nbcol))
tu coupes et tu colles en "B" & ligne+24
sinon t'as fini sortie de boucle
fin du si

ensuite tu incrémentes ligne de 23
retour boucle
------------------------------------------------------

:mouarf:
21/04/2013, 17h36
Matrixmax

C'est bien ce que j'ai essayé de faire mais çà n'as pas marché .. :/ ...

merci de me proposer un code et non une proposition litérale :D ... N'oublie pas queje suis nulle en VBA ...

merci infiniment chef ... !!

tu pousses un peu tout est dans la description
si tu enregistres tes actions tu verras le code, et comme beaucoup c'est comme ça que j'ai appris le vba

donc rapidement ça devrait être un truc dans ce genre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub test()
Dim flag_sortie, ligne, nbcol
Dim rupt_colonne                                         ' colonne de rupture
rupt_colonne = 6                                         ' à ajuster
flag_sortie = True                                       ' Initialise la variable de sortie.
While flag_sortie                                        ' Teste la variable et si égal à faux sort
    Range(Cells(ligne, 1), Cells(ligne + 23, 1)).Copy    ' on copie la colonne de départ
    Range(cell(ligne + 24, 1)).PasteSpecial (xlPasteAll) ' on colle
    nbcol = Application.WorksheetFunction.CountA(Range(ligne + 6 & ":" & ligne + 6)) '6 ou 5 je ne me souvient plus de ton tableau de départ
    If nbcol > rupt_colonne Then
        Range(Cells(ligne, rupt_colonne + 1), Cells(ligne + 23, nbcol)).Cut
        Range(cell(ligne + 24, 2)).PasteSpecial (xlPasteAll)
        ligne = ligne + 23
    Else
        flag_sortie = False
    End If
Wend    ' Met fin à la boucle .
End Sub

désolé, j'ai pas testé, mais ça tu peux peut être le faire en debug et adapter en fonction du résultat..., le débug c'est la touche F8
:weird:

----
Il ne s'agit pas de chercher à tout savoir mais de savoir où tout chercher
merci de penser à :resolu:

Le voilà le COde que j'ai établie espérant qu'il vous aide mesdames et mesieurs ..

Code:

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
 
Private Sub exporter()
 
Application.ScreenUpdating = False
 
Dim j, i, nb, k As Variant
Dim Cr As Integer
 
Cr = Worksheets(Sheets.Count).Cells(12, 2).End(xlToRight).Column
 
'//////////////////////////////copier la colonne 1
 
If Cr > 2 Then
 
    Rows("25:25").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Clear
 
 
nb = Int(Cr / 16)
 
i = 26
 
For j = 1 To nb
Range("A1:A23").Copy
Range(Cells(i, 1), Cells(i + 23, 1)).PasteSpecial
i = i + 26
Next j
 
If (Cr - nb * 16) > 1 Then
Range("A1:A23").Copy
Range(Cells(i, 1), Cells(i + 23, 1)).PasteSpecial
End If
 
i = 26
 
For j = 0 To nb - 1
 
Range(Cells(1, (16 * j + 2)), Cells(23, 16 * (j + 1) + 1)).Copy
Range("B" & i).Resize(23, 16).PasteSpecial
i = i + 26
 
Next j
 
If (Cr - nb * 16) > 1 Then
 
Range(Cells(1, (16 * nb) + 2), Cells(23, Cr)).Copy
 
Range("B" & i).Resize(23, Cr - nb).PasteSpecial
 
Range("A" & i + 3).Select
 
 
End If
 
Application.CutCopyMode = False
 
Range("A1").Select
 
End If
 
 
 
End If
 
End Sub